      ***************************************************************
       IDENTIFICATION DIVISION.
      ***************************************************************
       PROGRAM-ID.    P231F02.
       AUTHOR.        B.W. MCNULTY.
       DATE-WRITTEN.  APRIL 1, 1994.
      ***************************************************************
      *                                                             *
      *   PROGRAM:  P231F02 - FDAT - BOOK TABLE MENU LIST           *
      *                                                             *
      *   SYSTEM:   FDAT - TABLE MAINTENANCE SYSTEM                 *
      *                                                             *
      *   FUNCTION: THIS PROGRAM IS THE BOOK TABLE MENU LIST FOR    *
      *             ALL BOOK'S IN THE SELECTED DISTRIBUTION ID.     *
      *                                                             *
      *   LANGUAGE: COBOL II / SQL / CICS                           *
      *                                                             *
      *   ENTRY:    CICS TRANSACTION ID "FD02" THRU "FDAT"          *
      *                                                             *
      ***************************************************************
      *                                                             *
      *   DATABASE TABLES AND FILES:                                *
      *                                                             *
      *       T231ACS  - SECURITY ACCESS TABLE                      *
      *       T231SEC  - SECURITY DISTIRBUTION TABLE                *
      *       T231DIST - DISTRIBUTION TABLE                         *
      *       T231DSHD - DISTRIBUTION HEADER TABLE                  *
      *       T231DSLN - DISTRIBUTION LINE TABLE                    *
      *       T231DSBK - DISTRIBUTION BOOK TABLE                    *
      *       T231BOOK - BOOK TABLE                                 *
      *       T231RPT  - REPORT TABLE                               *
      *       T231LINE - LINE TABLE                                 *
      *       T231COL  - COLUMN TABLE                               *
      *       T231ORG  - ORGANIZATION TABLE                         *
      *       T231RGN  - REGION TABLE                               *
      *       T231PRIM - PRIME TABLE                                *
      *                                                             *
      ***************************************************************
      *                                                             *
      *   CALLED SUBROUTINES:                                       *
      *                                                             *
      ***************************************************************
      *                                                             *
      *   MODIFICATIONS:                                            *
      *                                                             *
      *   DATE      PROGRAMMER     DESCRIPTION                      *
      *   --------  -------------  -------------------------------  *
      *   04/01/94  B.W. MCNULTY   ORIGINAL VERSION.                *
      *                                                             *
      ***************************************************************

       ENVIRONMENT DIVISION.

           EJECT
       DATA DIVISION.

       WORKING-STORAGE SECTION.

       01  FILLER                      PIC X(35) VALUE
           'WORKING STORAGE BEGINS HERE ======>'.
      **===========================================================**
      **   PROGRAM ID CONSTANTS                                    **
      **===========================================================**
       01  W0000-PROGRAM-INFO.
           05  PROGRAM-NAME            PIC  X(08)  VALUE 'P231F02'.
           05  MAP-NAME                PIC  X(08)  VALUE 'M231F02'.
           05  SET-NAME                PIC  X(08)  VALUE 'M231F02'.
           05  MAP-NAME-1              PIC  X(08)  VALUE 'M231F02'.
           05  MAP-NAME-A              PIC  X(08)  VALUE 'M231F2A'.
           05  MAP-NAME-B              PIC  X(08)  VALUE 'M231F2B'.
           05  TXN-ID                  PIC  X(04)  VALUE 'FD02'.
           05  MAP-DATA                PIC  X(1920)  VALUE SPACES.

           05  ERROR-FLAG              PIC  X(01)  VALUE 'N'.
               88  NO-ERRORS                       VALUE 'N'.
               88  ERRORS                          VALUE 'Y'.

           05  M-MSG-24I               PIC  X(80)  VALUE SPACES.

      **===========================================================**
      **   MISCELLANEOUS WORK FIELDS                               **
      **===========================================================**
           EJECT
       01  W0001-MISCELLANEOUS-FIELDS.
           05  W0001-PGM-XCTL-NO       PIC  X(08)  VALUE SPACES.
           05  W0001-TXN-ID            PIC  X(04)  VALUE SPACES.
           05  W0001-XCTL-PGM-ID       PIC  X(08)  VALUE 'P231F02'.
           05  W0001-LINK-PGM-ID       PIC  X(08)  VALUE 'P231F02'.
           05  W0001-LINK-CA           PIC  X(999) VALUE SPACES.
           05  W0001-SCREEN-LINE-LIMIT PIC S9(09)  COMP-3 VALUE +09.
           05  W0001-SCREEN-A-LN-LIMIT PIC S9(09)  COMP-3 VALUE +12.
           05  W0001-SCREEN-B-LN-LIMIT PIC S9(09)  COMP-3 VALUE +14.
           05  W0001-COPY-CTR          PIC S9(09)  COMP-3 VALUE +0.
           05  W0001-BOOK-PREFIX       PIC  X(02)  VALUE SPACES.

           05  W0001-ABSTIME           PIC S9(16)  COMP.
           05  W0001-HHCMMCSS.
               10  W0001-HR            PIC  X(02).
               10  W0001-C1            PIC  X(01).
               10  W0001-MIN           PIC  X(02).
               10  W0001-C2            PIC  X(01).
               10  W0001-SEC           PIC  X(02).
           05  W0001-MMSDDSYY.
               10  W0001-MON           PIC  X(02).
               10  W0001-S1            PIC  X(01).
               10  W0001-DAY           PIC  X(02).
               10  W0001-S1            PIC  X(01).
               10  W0001-YEAR          PIC  X(02).
           05  W0001-YYYY.
               10  W0001-YY            PIC  X(04).

           05  W0001-DB2-ZERO-DATE     PIC  X(10) VALUE '01/01/0001'.
           05  W0001-DB2-MAX-DATE      PIC  X(10) VALUE '12/31/9999'.
           05  W0001-DB2-DATE.
               10  W0001-DB2-MM        PIC  X(02)  VALUE '01'.
               10  W0001-DB2-DASH1     PIC  X(01)  VALUE '/'.
               10  W0001-DB2-DD        PIC  X(02)  VALUE '01'.
               10  W0001-DB2-DASH2     PIC  X(01)  VALUE '/'.
               10  W0001-DB2-CC        PIC  X(02)  VALUE '19'.
               10  W0001-DB2-YY        PIC  X(02)  VALUE '99'.
           05  W0001-MMYY-DATE.
               10  W0001-MM            PIC  X(02).
               10  W0001-YY            PIC  X(02).

           05  W0001-X                 PIC S9(09)  COMP.
           05  W0001-IX                PIC S9(09)  COMP.
           05  W0001-IX2               PIC S9(09)  COMP.

           05  W0001-PD-X                      PIC X(02).
           05  W0001-PD  REDEFINES W0001-PD-X  PIC 9(02).

           05  W0001-FISCAL-PERIOD.
               10  W0001-FISCAL-CC       PIC  X(02)  VALUE SPACES.
               10  W0001-FISCAL-YY       PIC  X(02)  VALUE SPACES.
               10  W0001-FISCAL-MM       PIC  X(02)  VALUE SPACES.

           05  W0001-FYPD.
               10  W0001-FYPD-YY         PIC  X(02)  VALUE SPACES.
               10  W0001-FYPD-MM         PIC  X(02)  VALUE SPACES.

           05  W0001-SELECTION-FLAG      PIC  X(01)  VALUE 'N'.
               88  W0001-LINES-SELECTED              VALUE 'Y'.
               88  W0001-NO-LINES-SELECTED           VALUE 'N'.

           EJECT
       01  W0002-BOOK-TABLE.
           05  W0002-BOOK-ENTRIES OCCURS 9 TIMES INDEXED BY W0002-X.
               10  W0002-BOOK-ENTRY     PIC X(04).
               10  W0002-COPY-ENTRY     PIC X(02).
               10  W0002-BRST-ENTRY     PIC X(01).

           EJECT
      **===========================================================**
      **   FDAT - TRANSACTION ID'S                                 **
      **===========================================================**
           COPY C231WTXN.

           EJECT
      **===========================================================**
      **   PROGRAM MAP AREA                                        **
      **===========================================================**
           COPY M231F02.

           EJECT
      **===========================================================**
      **   CICS COPYBOOKS AREA                                     **
      **===========================================================**
           COPY C108CDBA.

           EJECT
           COPY DFHAID.

           EJECT
           COPY C751CONW.

           EJECT
           COPY C231MSGS.

           EJECT
           COPY C108W900.

           EJECT
           COPY C108W998.

           EJECT
           COPY D972ERRM.

           EJECT
      **===========================================================**
      **   DATE ROUTINE.                                           **
      **===========================================================**
      *BWM*COPY NSDTREC.

           EJECT
      **===========================================================**
      **   WORKING STORAGE COMMAREA                                **
      **===========================================================**
           COPY C231COMM.
               10  MAP-SAVE-AREA REDEFINES CA-MAP-SAVE-AREA.
                   15  ACTIVE-MAP-FLAG            PIC  X(01).
                       88  MAP-1-ACTIVE           VALUE '1'.
                       88  MAP-A-ACTIVE           VALUE 'A'.
                       88  MAP-B-ACTIVE           VALUE 'B'.

                   15  DELETE-REQUESTED-FLAG      PIC  X(01).
                       88  DELETE-REQUESTED       VALUE 'Y'.
                       88  DELETE-NOT-REQUESTED   VALUE 'N'.

                   15  INSERT-FLAG                PIC  X(01).
                       88  INSERT-SUCCESSFUL      VALUE 'Y'.
                       88  INSERT-NOT-SUCCESSFUL  VALUE 'N'.

                   15  WS-M-INDEX                 PIC S9(04) COMP.

                   15  WS-M-BOOKKEY-C             PIC  X(04).

      ** --------------------- MAP 1 SAVE AREA ----------------------**

                   15  WS-M-MIN-VALUES.
                       20  WS-M-MIN-BKID-C        PIC  X(04).

                   15  WS-M-MAX-VALUES.
                       20  WS-M-MAX-BKID-C        PIC  X(04).

                   15  WS-M-BOOK-SEQ              PIC  X(01).

                   15  WS-MAP-DATA-VALUES  OCCURS 11 TIMES.
                       20  WS-M-A-SEQ-N           PIC S9(09) COMP-3.
                       20  WS-M-F-BKID-C          PIC  X(04).
                       20  WS-M-F-RPTGRP-C        PIC  X(03).
                       20  WS-M-F-BKID-X          PIC  X(80).
                       20  WS-M-F-RPTSEQ-C        PIC  X(01).
                       20  WS-M-A-CPYP1-N         PIC  X(02).
                       20  WS-M-A-CPYP2-N         PIC  X(02).
                       20  WS-M-A-CPYFN-N         PIC  X(02).
                       20  WS-M-A-CPYQ1-N         PIC  X(02).
                       20  WS-M-A-CPYQ2-N         PIC  X(02).
                       20  WS-M-A-CPYQ3-N         PIC  X(02).
                       20  WS-M-A-CPYQN-N         PIC  X(02).


      ** --------------------- MAP A SAVE AREA ----------------------**

                   15  WS-M-A-MIN-VALUES.
                       20  WS-M-A-MIN-SEQ-N       PIC S9(09) COMP-3.
                       20  WS-M-A-MIN-BKID-C      PIC  X(04).
                       20  WS-M-A-MIN-RPTGRP-C    PIC  X(03).

                   15  WS-M-A-MAX-VALUES.
                       20  WS-M-A-MAX-SEQ-N       PIC S9(09) COMP-3.
                       20  WS-M-A-MAX-BKID-C      PIC  X(04).
                       20  WS-M-A-MAX-RPTGRP-C    PIC  X(03).

                   15  WS-MAP-A-DATA-VALUES  OCCURS 13 TIMES.
                       20  WS-M-A-A-SEQ-N         PIC S9(09) COMP-3.
                       20  WS-M-A-F-BKID-C        PIC  X(04).
                       20  WS-M-A-F-RPTGRP-C      PIC  X(03).
                       20  WS-M-A-F-BKID-X        PIC  X(20).

           EJECT
      **===========================================================**
      **   DB2 INCLUDES                                            **
      **===========================================================**
           EXEC SQL
                INCLUDE SQLCA
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231ACS
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231SEC
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231DIST
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231DSHD
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231DSLN
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231DSBK
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231BOOK
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231RPT
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231LINE
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231COL
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231ORG
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231RGN
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231PRIM
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231ORGF
           END-EXEC.


           EJECT
      **===========================================================**
      **   DB2 CURSORS                                             **
      **===========================================================**

      **===========================================================**
      **   CSR_1 IS THE FORWARD SCROLLING CURSOR FOR SCREEN 1.     **
      **===========================================================**
           EXEC SQL
                DECLARE CSR_1 CURSOR FOR
                 SELECT F_BKID_C
                      , A_CPYP1_N
                      , A_CPYP2_N
                      , A_CPYFN_N
                      , A_CPYQ1_N
                      , A_CPYQ2_N
                      , A_CPYQ3_N
                      , A_CPYQN_N
                   FROM D231.T231DSBK
                  WHERE F_DSID_C    = :DCLT231DSBK.F-DSID-C
                    AND F_DSLN_N    = :DCLT231DSBK.F-DSLN-N
                    AND F_BKID_C   >= :DCLT231DSBK.F-BKID-C
                  ORDER BY 1
           END-EXEC.

           EJECT
      **===========================================================**
      **   CSR_2 IS THE BACKWARD SCROLLING CURSOR FOR SCREEN 1.    **
      **===========================================================**
           EXEC SQL
                DECLARE CSR_2 CURSOR FOR
                 SELECT F_BKID_C
                      , A_CPYP1_N
                      , A_CPYP2_N
                      , A_CPYFN_N
                      , A_CPYQ1_N
                      , A_CPYQ2_N
                      , A_CPYQ3_N
                      , A_CPYQN_N
                   FROM D231.T231DSBK
                  WHERE F_DSID_C    = :DCLT231DSBK.F-DSID-C
                    AND F_DSLN_N    = :DCLT231DSBK.F-DSLN-N
                    AND F_BKID_C   <= :DCLT231DSBK.F-BKID-C
                  ORDER BY 1 DESC
           END-EXEC.

           EJECT
      **===========================================================**
      **   CSR_3 IS USED TO DETERMINE IF A BOOK ID ENTERED EXISTS  **
      **   ON ANY OF THE DISTRIBUTION RECORDS.                     **
      **===========================================================**
           EXEC SQL
                DECLARE CSR_3 CURSOR FOR
                 SELECT F_BKID_C
                   FROM D231.T231DSBK
                  WHERE F_DSID_C    = :DCLT231DSBK.F-DSID-C
                    AND F_DSLN_N    = :DCLT231DSBK.F-DSLN-N
                    AND F_BKID_C    = :DCLT231DSBK.F-BKID-C
           END-EXEC.

           EJECT
      **===========================================================**
      **   CSR_4 IS USED TO GET THE BOOK DESCRIPTION AND ALSO TO   **
      **   VALIDATE THE ADDITION OF BOOKS TO THE DISTRIBUTION ID.  **
      **===========================================================**
           EXEC SQL
                DECLARE CSR_4 CURSOR FOR
                 SELECT F_BKID_X
                      , DB_RECTYP_C
                      , A_SEQ_N
                   FROM D231.T231BOOK
                  WHERE F_BKID_C     = :DCLT231BOOK.F-BKID-C
                 ORDER BY
                        DB_RECTYP_C
                      , A_SEQ_N
           END-EXEC.

           EJECT
      **===========================================================**
      **   CSR_5 IS THE FORWARD SCROLLING CURSOR FOR SCREEN A.     **
      **===========================================================**
           EXEC SQL
                DECLARE CSR_5 CURSOR FOR
                 SELECT F_BKID_C
                      , F_RPTGRP_C
                      , A_SEQ_N
                      , DB_RECTYP_C
                      , F_BKID_X
                   FROM D231.T231BOOK
                  WHERE DB_RECTYP_C     = '/'
                    AND A_SEQ_N         = +1
                    AND F_RPTGRP_C      = '   '
                    AND F_BKID_C       >= :DCLT231BOOK.F-BKID-C
                    AND ( SUBSTR(F_BKID_C,1,2) IN
                          (SELECT DISTINCT SUBSTR(F_AFM_C,1,2)
                             FROM D231.T231SEC A
                            WHERE A.A_UID_C     = :DCLT231SEC.A-UID-C
                              AND A.DB_RECTYP_C = 'B')
                        OR EXISTS
                         ( SELECT *
                             FROM D231.T231ACS B
                            WHERE B.A_UID_C    = :DCLT231SEC.A-UID-C
                              AND B.A_UIDTYP_C = 'C')
                        )
                  ORDER BY
                        F_BKID_C
           END-EXEC.

           EJECT
      **===========================================================**
      **   CSR_6 IS THE BACKWARD SCROLLING CURSOR FOR SCREEN A.    **
      **===========================================================**
           EXEC SQL
                DECLARE CSR_6 CURSOR FOR
                 SELECT F_BKID_C
                      , F_RPTGRP_C
                      , A_SEQ_N
                      , DB_RECTYP_C
                      , F_BKID_X
                   FROM D231.T231BOOK
                  WHERE DB_RECTYP_C     = '/'
                    AND A_SEQ_N         = +1
                    AND F_RPTGRP_C      = '   '
                    AND F_BKID_C       <= :DCLT231BOOK.F-BKID-C
                    AND ( SUBSTR(F_BKID_C,1,2) IN
                          (SELECT DISTINCT SUBSTR(F_AFM_C,1,2)
                             FROM D231.T231SEC A
                            WHERE A.A_UID_C     = :DCLT231SEC.A-UID-C
                              AND A.DB_RECTYP_C = 'B')
                        OR EXISTS
                         ( SELECT *
                             FROM D231.T231ACS B
                            WHERE B.A_UID_C    = :DCLT231SEC.A-UID-C
                              AND B.A_UIDTYP_C = 'C')
                        )
                  ORDER BY
                        F_BKID_C  DESC
           END-EXEC.

           EJECT
      **===========================================================**
      **   CSR_7 IS THE COPY CURSOR.                               **
      **===========================================================**
           EXEC SQL
                DECLARE CSR_7 CURSOR FOR
                 SELECT F_BKID_C
                      , F_RPTGRP_C
                      , A_SEQ_N
                      , DB_RECTYP_C
                      , F_BKID_X
                      , F_TBL_C
                      , A_PGCNT_N
                      , F_RPT01_C
                      , F_RPT02_C
                      , F_RPT03_C
                      , F_RPT04_C
                      , F_RPT05_C
                      , F_RPT06_C
                      , F_RPT07_C
                      , F_RPT08_C
                      , F_RPT09_C
                      , F_RPT10_C
                      , F_RPT11_C
                      , F_RPT12_C
                      , F_RPT13_C
                      , F_RPT14_C
                      , F_RPT15_C
                      , F_RPT16_C
                      , F_RPT17_C
                      , F_RPT18_C
                      , F_RPT19_C
                      , F_RPT20_C
                      , F_RPT21_C
                      , F_RPT22_C
                   FROM D231.T231BOOK
                  WHERE F_BKID_C        = :DCLT231BOOK.F-BKID-C
                  ORDER BY
                        F_RPTGRP_C
                      , A_SEQ_N
           END-EXEC.

           EJECT
      **===========================================================**
      **   CSR_8 IS THE MEMO PAGE UPDATE CURSOR FOR SCREEN B.      **
      **===========================================================**
           EXEC SQL
                DECLARE CSR_8 CURSOR FOR
                 SELECT F_BKID_C
                      , F_RPTGRP_C
                      , A_SEQ_N
                      , DB_RECTYP_C
                      , F_BKID_X
                   FROM D231.T231BOOK
                  WHERE DB_RECTYP_C     = '1'
                    AND F_BKID_C        = :DCLT231BOOK.F-BKID-C
                  ORDER BY
                        A_SEQ_N
           END-EXEC.

      **===========================================================**
      **   END OF WORKING STORAGE SECTION                          **
      **===========================================================**
           EJECT
       LINKAGE SECTION.

       01  DFHCOMMAREA.
           05  FILLER                   PICTURE X(4096).

           EJECT
       PROCEDURE DIVISION.

           EXEC CICS HANDLE ABEND
                LABEL    (Z900-HANDLE-ERROR)
           END-EXEC.

           EXEC CICS HANDLE CONDITION
                ERROR    (Z900-HANDLE-ERROR)
                ILLOGIC  (Z900-HANDLE-ERROR)
                DSIDERR  (Z900-HANDLE-ERROR)
                INVREQ   (Z900-HANDLE-ERROR)
                IOERR    (Z900-HANDLE-ERROR)
                ISCINVREQ(Z900-HANDLE-ERROR)
                NOSPACE  (Z900-HANDLE-ERROR)
           END-EXEC.

       A000-MAINLINE.

           MOVE 'A000'      TO CA-PARAGRAPH-NBR.

           PERFORM A100-INITIALIZATION.

           IF  CA-CURRENT-PGM = PROGRAM-NAME
               PERFORM A300-ACCEPT-SCREEN

               EVALUATE TRUE
                   WHEN MAP-1-ACTIVE
                        PERFORM A001-PROCESS-MAP-1
                   WHEN MAP-A-ACTIVE
                        PERFORM A002-PROCESS-MAP-A
                   WHEN MAP-B-ACTIVE
                        PERFORM A003-PROCESS-MAP-B
               END-EVALUATE
           END-IF.

           PERFORM A200-DISPLAY-SCREEN.

           PERFORM Y100-REPEAT-PROGRAM.

           EJECT
       A001-PROCESS-MAP-1.

           MOVE 'A001'      TO CA-PARAGRAPH-NBR.

           SET INSERT-NOT-SUCCESSFUL    TO TRUE.

           IF  EIBAID NOT EQUAL DFHPF10
               SET DELETE-NOT-REQUESTED TO TRUE
           END-IF.

           EVALUATE TRUE
               WHEN EIBAID = DFHENTER
                    PERFORM B000-PROCESS-ENTER-KEY
                    IF  W0001-LINES-SELECTED
                        MOVE BOOK-UPD-TXN-ID  TO W0001-TXN-ID
                        PERFORM Y700-START-TRANSACTION
                    END-IF
               WHEN EIBAID = DFHCLEAR
                    PERFORM Y400-RETURN-TO-CICS
               WHEN EIBAID = DFHPF3
                    MOVE DIST-MENU-TXN-ID     TO W0001-TXN-ID
                    PERFORM Y700-START-TRANSACTION
               WHEN EIBAID = DFHPF4
                    PERFORM A700-CHECK-FOR-SELECTION
                    IF  NO-ERRORS
                        PERFORM M000-PROCESS-MEMO-PAGE
                    END-IF
               WHEN EIBAID = DFHPF5
                    PERFORM G100-UPDATE-T231DSBK-LINE
               WHEN EIBAID = DFHPF6
                    PERFORM G000-ADD-BOOK-TO-DIST
                    IF  NO-ERRORS
                        MOVE SPACES TO WS-M-MAX-BKID-C
                        SET NO-ERRORS       TO TRUE
                        PERFORM C000-PROCESS-NEXT-PAGE
                        MOVE W9999-MSG-012  TO M-MSG-22I
                    END-IF
               WHEN EIBAID = DFHPF7
                    PERFORM D000-PROCESS-PREV-PAGE
                    IF  M-BKID-CI (1)  EQUAL SPACES
                        INITIALIZE WS-M-MAX-VALUES
                        SET NO-ERRORS       TO TRUE
                        PERFORM C000-PROCESS-NEXT-PAGE
                        MOVE W9999-MSG-005  TO M-MSG-22I
                    END-IF
               WHEN EIBAID = DFHPF8
                    PERFORM C000-PROCESS-NEXT-PAGE
               WHEN EIBAID = DFHPF9
                    INITIALIZE WS-M-A-MAX-VALUES
                    PERFORM E000-PROCESS-NEXT-PAGE
                    SET MAP-A-ACTIVE     TO TRUE
                    SET CA-ENTRY         TO TRUE
                    MOVE W9999-MSG-021   TO M-MSG-22AI
                    MOVE -1              TO M-BOOKKEY-CAL
               WHEN EIBAID = DFHPF10
                    PERFORM I000-DELETE-T231DSBK
                    IF  NO-ERRORS
                        MOVE WS-M-MIN-VALUES
                          TO WS-M-MAX-VALUES
                        PERFORM C000-PROCESS-NEXT-PAGE
                        MOVE W9999-MSG-014 TO M-MSG-22I
                    END-IF
               WHEN EIBAID = DFHPF11
                    PERFORM H000-COPY-TO-NEW-BOOK
                    IF  NO-ERRORS
                        MOVE WS-M-MIN-VALUES
                          TO WS-M-MAX-VALUES
                        PERFORM C000-PROCESS-NEXT-PAGE
                        MOVE W9999-MSG-020 TO M-MSG-22I
                    END-IF
               WHEN EIBAID = DFHPF12
                    MOVE DIST-MAINT-TXN-ID TO W0001-TXN-ID
                    PERFORM Y700-START-TRANSACTION
               WHEN OTHER
                    MOVE -1             TO M-BOOKKEY-CL
                    SET ERRORS          TO TRUE
                    MOVE W9999-MSG-002  TO M-MSG-22I
           END-EVALUATE.

           EJECT
       A002-PROCESS-MAP-A.

           MOVE 'A002'      TO CA-PARAGRAPH-NBR.

           IF  EIBAID NOT EQUAL DFHPF10
               SET DELETE-NOT-REQUESTED TO TRUE
           END-IF.

           EVALUATE TRUE
               WHEN EIBAID = DFHENTER
                    PERFORM E100-PROCESS-ENTER-KEY
               WHEN EIBAID = DFHCLEAR
                    PERFORM Y400-RETURN-TO-CICS
               WHEN EIBAID = DFHPF3
                    SET MAP-1-ACTIVE    TO TRUE
                    SET CA-INQUIRY      TO TRUE
                    IF  INSERT-SUCCESSFUL
                        MOVE SPACES TO WS-M-MAX-BKID-C
                        PERFORM C000-PROCESS-NEXT-PAGE
                    ELSE
                        PERFORM B400-DISPLAY-SCREEN-1
                    END-IF
                    SET INSERT-NOT-SUCCESSFUL TO TRUE
               WHEN EIBAID = DFHPF6
                    PERFORM J000-ADD-BOOK-TO-DIST
               WHEN EIBAID = DFHPF7
                    PERFORM F000-PROCESS-PREV-PAGE
                    IF  M-BKID-CAI (1) EQUAL SPACES
                        INITIALIZE WS-M-A-MAX-VALUES
                        SET NO-ERRORS       TO TRUE
                        PERFORM E000-PROCESS-NEXT-PAGE
                        MOVE W9999-MSG-005  TO M-MSG-22AI
                    END-IF
               WHEN EIBAID = DFHPF8
                    PERFORM E000-PROCESS-NEXT-PAGE
               WHEN EIBAID = DFHPF10
                    PERFORM K000-DELETE-T231BOOK
                    IF  NO-ERRORS
                        MOVE WS-M-A-MIN-VALUES
                          TO WS-M-A-MAX-VALUES
                        PERFORM E000-PROCESS-NEXT-PAGE
                        MOVE W9999-MSG-014 TO M-MSG-22AI
                    END-IF
               WHEN EIBAID = DFHPF11
                    PERFORM N000-COPY-TO-NEW-BOOK
                    IF  NO-ERRORS
                        MOVE WS-M-A-MIN-VALUES
                          TO WS-M-A-MAX-VALUES
                        PERFORM E000-PROCESS-NEXT-PAGE
                        MOVE W9999-MSG-020 TO M-MSG-22AI
                    END-IF
               WHEN EIBAID = DFHPF12
                    SET MAP-1-ACTIVE    TO TRUE
                    SET CA-INQUIRY      TO TRUE
                    IF  INSERT-SUCCESSFUL
                        MOVE SPACES TO WS-M-MAX-BKID-C
                        PERFORM C000-PROCESS-NEXT-PAGE
                    ELSE
                        PERFORM B400-DISPLAY-SCREEN-1
                    END-IF
                    SET INSERT-NOT-SUCCESSFUL TO TRUE
               WHEN OTHER
                    MOVE -1             TO M-BOOKKEY-CAL
                    SET ERRORS          TO TRUE
                    MOVE W9999-MSG-002  TO M-MSG-22AI
           END-EVALUATE.

           EJECT
       A003-PROCESS-MAP-B.

           MOVE 'A003'      TO CA-PARAGRAPH-NBR.

           EVALUATE TRUE
               WHEN EIBAID = DFHENTER
                    PERFORM L100-PROCESS-ENTER-KEY
               WHEN EIBAID = DFHCLEAR
                    PERFORM Y400-RETURN-TO-CICS
               WHEN EIBAID = DFHPF3
                    SET MAP-1-ACTIVE    TO TRUE
                    SET CA-INQUIRY      TO TRUE
                    IF  INSERT-SUCCESSFUL
                        MOVE WS-M-MIN-VALUES
                          TO WS-M-MAX-VALUES
                        PERFORM C000-PROCESS-NEXT-PAGE
                    ELSE
                        PERFORM B400-DISPLAY-SCREEN-1
                    END-IF
                    SET INSERT-NOT-SUCCESSFUL TO TRUE
               WHEN EIBAID = DFHPF5
                    PERFORM L200-UPDATE-T231BOOK
                    IF  NO-ERRORS
                        PERFORM M000-PROCESS-MEMO-PAGE
                    END-IF
               WHEN EIBAID = DFHPF12
                    SET MAP-1-ACTIVE    TO TRUE
                    SET CA-INQUIRY      TO TRUE
                    IF  INSERT-SUCCESSFUL
                        MOVE WS-M-MIN-VALUES
                          TO WS-M-MAX-VALUES
                        PERFORM C000-PROCESS-NEXT-PAGE
                    ELSE
                        PERFORM B400-DISPLAY-SCREEN-1
                    END-IF
                    SET INSERT-NOT-SUCCESSFUL TO TRUE
               WHEN OTHER
                    MOVE -1             TO M-BKID-CBL
                    SET ERRORS          TO TRUE
                    MOVE W9999-MSG-002  TO M-MSG-22BI
           END-EVALUATE.

           EJECT
       A100-INITIALIZATION.

           MOVE 'A100'      TO CA-PARAGRAPH-NBR.

           IF  EIBCALEN NOT EQUAL ZEROES
               MOVE DFHCOMMAREA TO WS-COMMAREA
               IF  CA-CURRENT-PGM = PROGRAM-NAME
                   CONTINUE
               ELSE
                   MOVE CA-CURRENT-PGM TO CA-PREV-PGM
                   MOVE CA-CURRENT-TXN TO CA-PREV-TXN
                   PERFORM A150-SETUP-COMMAREA
               END-IF
           ELSE
               MOVE MAIN-MENU-TXN-ID  TO W0001-TXN-ID
               PERFORM Y600-START-TRANSACTION
           END-IF.

           EJECT
       A150-SETUP-COMMAREA.

           MOVE 'A150'      TO CA-PARAGRAPH-NBR.

           EXEC CICS ASKTIME
                ABSTIME (W0001-ABSTIME)
           END-EXEC.

           EXEC CICS FORMATTIME
                ABSTIME (W0001-ABSTIME)
                TIME    (W0001-HHCMMCSS)
                TIMESEP
                MMDDYY  (W0001-MMSDDSYY)
                DATESEP
                YEAR    (W0001-YYYY)
           END-EXEC.

           MOVE W0001-MMSDDSYY    TO M-DATEI
                                     CA-DATE.
           MOVE W0001-HHCMMCSS    TO M-TIMEI
                                     CA-TIME.

           EJECT
       A200-DISPLAY-SCREEN.

           MOVE 'A200'      TO CA-PARAGRAPH-NBR.

           IF  CA-CURRENT-PGM = PROGRAM-NAME
               PERFORM A210-SAVE-MAP
           ELSE
               INITIALIZE  MAP-SAVE-AREA
               INITIALIZE  M231F02I
               INITIALIZE  M231F2AI
               MOVE -1             TO M-BOOKKEY-CL
               MOVE SPACES         TO WS-M-MAX-BKID-C
               SET MAP-1-ACTIVE    TO TRUE
               MOVE MAP-NAME-1     TO MAP-NAME
               PERFORM C000-PROCESS-NEXT-PAGE
           END-IF.

           EVALUATE TRUE
               WHEN MAP-1-ACTIVE
                    PERFORM A220-SET-SCREEN-1-ATTRIBUTES
                    MOVE MAP-NAME-1 TO MAP-NAME
                    MOVE M231F02I   TO MAP-DATA
               WHEN MAP-A-ACTIVE
                    PERFORM A221-SET-SCREEN-A-ATTRIBUTES
                    MOVE MAP-NAME-A TO MAP-NAME
                    MOVE M231F2AI   TO MAP-DATA
               WHEN MAP-B-ACTIVE
                    PERFORM A222-SET-SCREEN-B-ATTRIBUTES
                    MOVE MAP-NAME-B TO MAP-NAME
                    MOVE M231F2BI   TO MAP-DATA
           END-EVALUATE.

           EXEC CICS HANDLE CONDITION
                MAPFAIL (Z100-MAPFAIL)
                ERROR   (Z200-NO-MAPFAIL)
           END-EXEC.

           EXEC CICS SEND
                MAP    (MAP-NAME)
                MAPSET (SET-NAME)
                FROM   (MAP-DATA)
                ERASE
                CURSOR
           END-EXEC.

           EJECT
       A210-SAVE-MAP.

           MOVE 'A210'      TO CA-PARAGRAPH-NBR.

           EJECT
       A220-SET-SCREEN-1-ATTRIBUTES.

           MOVE 'A220'      TO CA-PARAGRAPH-NBR.

           MOVE ATTR-ALPHA-PROT-BRT-PEN
             TO M-UID-CA
                M-FYPDA
                M-DATEA
                M-TIMEA
                M-MSG-22A.

           MOVE ATTR-ALPHA-PROT-MDT
             TO M-DSID-CA
                M-DSID-NA
                M-DSID-XA
                M-DEST-CA
                M-NOVA01-CA
                M-NOVA02-CA
                M-NOVA03-CA
                M-MICRO-CA.

           MOVE ATTR-ALPHA-UNPROT-MDT
             TO M-BOOKKEY-CA.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-LINE-LIMIT

               MOVE ATTR-ALPHA-UNPROT-MDT
                 TO M-ACT-CA    (W0001-X)
                    M-CPYP1-NA  (W0001-X)
                    M-CPYP2-NA  (W0001-X)
                    M-CPYFN-NA  (W0001-X)
                    M-CPYQ1-NA  (W0001-X)
                    M-CPYQ2-NA  (W0001-X)
                    M-CPYQ3-NA  (W0001-X)
                    M-CPYQN-NA  (W0001-X)

               MOVE ATTR-ALPHA-PROT-MDT
                 TO M-BKID-CA   (W0001-X)
                    M-BKID-XA   (W0001-X)

               IF  M-BKID-CI (W0001-X) EQUAL SPACES
                   MOVE ATTR-ALPHA-PROT-MDT
                     TO M-ACT-CA    (W0001-X)
                        M-CPYP1-NA  (W0001-X)
                        M-CPYP2-NA  (W0001-X)
                        M-CPYFN-NA  (W0001-X)
                        M-CPYQ1-NA  (W0001-X)
                        M-CPYQ2-NA  (W0001-X)
                        M-CPYQ3-NA  (W0001-X)
                        M-CPYQN-NA  (W0001-X)
                   MOVE SPACES
                     TO M-ACT-CI (W0001-X)
               ELSE
                   MOVE M-ACT-CI (W0001-X) TO W9998-DATA
                   PERFORM Z998-MOVE-UNDERSCORES
                   MOVE W9998-DATA  TO M-ACT-CI (W0001-X)

                   MOVE M-CPYP1-NI (W0001-X) TO W9998-DATA
                   PERFORM Z998-MOVE-UNDERSCORES
                   MOVE W9998-DATA  TO M-CPYP1-NI (W0001-X)

                   MOVE M-CPYP2-NI (W0001-X) TO W9998-DATA
                   PERFORM Z998-MOVE-UNDERSCORES
                   MOVE W9998-DATA  TO M-CPYP2-NI (W0001-X)

                   MOVE M-CPYFN-NI (W0001-X) TO W9998-DATA
                   PERFORM Z998-MOVE-UNDERSCORES
                   MOVE W9998-DATA  TO M-CPYFN-NI (W0001-X)

                   MOVE M-CPYQ1-NI (W0001-X) TO W9998-DATA
                   PERFORM Z998-MOVE-UNDERSCORES
                   MOVE W9998-DATA  TO M-CPYQ1-NI (W0001-X)

                   MOVE M-CPYQ2-NI (W0001-X) TO W9998-DATA
                   PERFORM Z998-MOVE-UNDERSCORES
                   MOVE W9998-DATA  TO M-CPYQ2-NI (W0001-X)

                   MOVE M-CPYQ3-NI (W0001-X) TO W9998-DATA
                   PERFORM Z998-MOVE-UNDERSCORES
                   MOVE W9998-DATA  TO M-CPYQ3-NI (W0001-X)

                   MOVE M-CPYQN-NI (W0001-X) TO W9998-DATA
                   PERFORM Z998-MOVE-UNDERSCORES
                   MOVE W9998-DATA  TO M-CPYQN-NI (W0001-X)
               END-IF
           END-PERFORM.

           MOVE M-BOOKKEY-CI   TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-BOOKKEY-CI.

           MOVE CA-CURR-F-DSID-C  TO M-DSID-CI.
           MOVE CA-CURR-F-DSID-N  TO M-DSID-NI.
           MOVE CA-CURR-F-DSLN-X  TO M-DSID-XI.

           MOVE CA-CURR-A-DEST-C   TO M-DEST-CI.
           MOVE CA-CURR-A-NOVA01-C TO M-NOVA01-CI.
           MOVE CA-CURR-A-NOVA02-C TO M-NOVA02-CI.
           MOVE CA-CURR-A-NOVA03-C TO M-NOVA03-CI.
           MOVE CA-CURR-A-MICRO-C  TO M-MICRO-CI.

           MOVE CA-OP-ID       TO M-UID-CI.
           MOVE CA-FYPD        TO M-FYPDI.
           MOVE CA-DATE        TO M-DATEI.
           MOVE CA-TIME        TO M-TIMEI.

           EJECT
       A221-SET-SCREEN-A-ATTRIBUTES.

           MOVE 'A221'      TO CA-PARAGRAPH-NBR.

           MOVE ATTR-ALPHA-PROT-BRT-PEN
             TO M-UID-CAA
                M-FYPDAA
                M-DATEAA
                M-TIMEAA
                M-MSG-22AA.

           MOVE ATTR-ALPHA-UNPROT-MDT
             TO M-BOOKKEY-CAA.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-A-LN-LIMIT

               MOVE ATTR-ALPHA-UNPROT-MDT
                 TO M-ACT-CAA       (W0001-X)

               MOVE ATTR-ALPHA-PROT-MDT
                 TO M-BKID-CAA      (W0001-X)
                    M-BKID-XAA      (W0001-X)

               IF  M-BKID-CAI (W0001-X) EQUAL SPACES
                   MOVE ATTR-ALPHA-PROT-MDT
                     TO M-ACT-CAA    (W0001-X)
                   MOVE SPACES
                     TO M-ACT-CAI    (W0001-X)
               ELSE
                   MOVE M-ACT-CAI (W0001-X) TO W9998-DATA
                   PERFORM Z998-MOVE-UNDERSCORES
                   MOVE W9998-DATA  TO M-ACT-CAI (W0001-X)
               END-IF
           END-PERFORM.

           MOVE M-BOOKKEY-CAI   TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA      TO M-BOOKKEY-CAI.

           MOVE CA-OP-ID       TO M-UID-CAI.
           MOVE CA-FYPD        TO M-FYPDAI.
           MOVE CA-DATE        TO M-DATEAI.
           MOVE CA-TIME        TO M-TIMEAI.

           EJECT
       A222-SET-SCREEN-B-ATTRIBUTES.

           MOVE 'A222'      TO CA-PARAGRAPH-NBR.

           MOVE ATTR-ALPHA-PROT-BRT-PEN
             TO M-UID-CBA
                M-FYPDBA
                M-DATEBA
                M-TIMEBA
                M-MSG-22BA.

           MOVE ATTR-ALPHA-PROT-MDT
             TO M-DSID-CBA
                M-DSID-NBA
                M-DSID-XBA
                M-BKID-CBA.

           MOVE ATTR-ALPHA-UNPROT-MDT
             TO M-BKID-XBA.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-B-LN-LIMIT

               MOVE ATTR-ALPHA-UNPROT-MDT
                 TO M-MEMO-CBA (W0001-X)

               MOVE M-MEMO-CBI (W0001-X)  TO W9998-DATA
               PERFORM Z998-MOVE-UNDERSCORES
               MOVE W9998-DATA            TO M-MEMO-CBI (W0001-X)
           END-PERFORM.

           MOVE M-BKID-XBI      TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA      TO M-BKID-XBI.

           MOVE CA-CURR-F-DSID-C  TO M-DSID-CBI.
           MOVE CA-CURR-F-DSID-N  TO M-DSID-NBI.
           MOVE CA-CURR-F-DSLN-X  TO M-DSID-XBI.

           MOVE CA-OP-ID       TO M-UID-CBI.
           MOVE CA-FYPD        TO M-FYPDBI.
           MOVE CA-DATE        TO M-DATEBI.
           MOVE CA-TIME        TO M-TIMEBI.

           EJECT
       A300-ACCEPT-SCREEN.

           MOVE 'A300'      TO CA-PARAGRAPH-NBR.

           EVALUATE TRUE
               WHEN MAP-1-ACTIVE
                    MOVE MAP-NAME-1 TO MAP-NAME
               WHEN MAP-A-ACTIVE
                    MOVE MAP-NAME-A TO MAP-NAME
               WHEN MAP-B-ACTIVE
                    MOVE MAP-NAME-B TO MAP-NAME
           END-EVALUATE.

           EXEC CICS IGNORE CONDITION
                MAPFAIL
           END-EXEC.

           EXEC CICS HANDLE CONDITION
                ERROR (Z200-NO-MAPFAIL)
           END-EXEC.

           EXEC CICS RECEIVE
                MAP    (MAP-NAME)
                MAPSET (SET-NAME)
                INTO   (MAP-DATA)
           END-EXEC.

           EVALUATE TRUE
               WHEN MAP-1-ACTIVE
                    MOVE MAP-DATA TO M231F02I
                    PERFORM A310-PROCESS-MAP-1-FIELDS
               WHEN MAP-A-ACTIVE
                    MOVE MAP-DATA TO M231F2AI
                    PERFORM A311-PROCESS-MAP-A-FIELDS
               WHEN MAP-B-ACTIVE
                    MOVE MAP-DATA TO M231F2BI
                    PERFORM A312-PROCESS-MAP-B-FIELDS
           END-EVALUATE.

           EJECT
       A310-PROCESS-MAP-1-FIELDS.

           MOVE 'A310'      TO CA-PARAGRAPH-NBR.

           INSPECT M-BOOKKEY-CI REPLACING ALL '_' BY ' '.

           INSPECT M-BOOKKEY-CI REPLACING ALL LOW-VALUES BY ' '.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-LINE-LIMIT
                   INSPECT M-ACT-CI   (W0001-X) REPLACING ALL '_' BY ' '
                   INSPECT M-CPYP1-NI (W0001-X) REPLACING ALL '_' BY ' '
                   INSPECT M-CPYP2-NI (W0001-X) REPLACING ALL '_' BY ' '
                   INSPECT M-CPYFN-NI (W0001-X) REPLACING ALL '_' BY ' '
                   INSPECT M-CPYQ1-NI (W0001-X) REPLACING ALL '_' BY ' '
                   INSPECT M-CPYQ2-NI (W0001-X) REPLACING ALL '_' BY ' '
                   INSPECT M-CPYQ3-NI (W0001-X) REPLACING ALL '_' BY ' '
                   INSPECT M-CPYQN-NI (W0001-X) REPLACING ALL '_' BY ' '

                   INSPECT M-ACT-CI   (W0001-X)
                       REPLACING ALL LOW-VALUES BY ' '
                   INSPECT M-CPYP1-NI (W0001-X)
                       REPLACING ALL LOW-VALUES BY ' '
                   INSPECT M-CPYP2-NI (W0001-X)
                       REPLACING ALL LOW-VALUES BY ' '
                   INSPECT M-CPYFN-NI (W0001-X)
                       REPLACING ALL LOW-VALUES BY ' '
                   INSPECT M-CPYQ1-NI (W0001-X)
                       REPLACING ALL LOW-VALUES BY ' '
                   INSPECT M-CPYQ2-NI (W0001-X)
                       REPLACING ALL LOW-VALUES BY ' '
                   INSPECT M-CPYQ3-NI (W0001-X)
                       REPLACING ALL LOW-VALUES BY ' '
                   INSPECT M-CPYQN-NI (W0001-X)
                       REPLACING ALL LOW-VALUES BY ' '
           END-PERFORM.

           EJECT
       A311-PROCESS-MAP-A-FIELDS.

           MOVE 'A311'      TO CA-PARAGRAPH-NBR.

           INSPECT M-BOOKKEY-CAI REPLACING ALL '_' BY ' '.

           INSPECT M-BOOKKEY-CAI REPLACING ALL LOW-VALUES BY ' '.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-A-LN-LIMIT
                   INSPECT M-ACT-CAI (W0001-X) REPLACING ALL '_' BY ' '
                   INSPECT M-ACT-CAI (W0001-X)
                       REPLACING ALL LOW-VALUES BY ' '
           END-PERFORM.

           EJECT
       A312-PROCESS-MAP-B-FIELDS.

           MOVE 'A312'      TO CA-PARAGRAPH-NBR.

           INSPECT M-BKID-XBI    REPLACING ALL '_' BY ' '.

           INSPECT M-BKID-XBI    REPLACING ALL LOW-VALUES BY ' '.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-B-LN-LIMIT
                  INSPECT M-MEMO-CBI (W0001-X) REPLACING ALL '_' BY ' '
                  INSPECT M-MEMO-CBI (W0001-X)
                      REPLACING ALL LOW-VALUES BY ' '
           END-PERFORM.

           EJECT
       A700-CHECK-FOR-SELECTION.

           MOVE 'A700'      TO CA-PARAGRAPH-NBR.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-LINE-LIMIT
                OR W0001-LINES-SELECTED
                   IF  M-ACT-CI (W0001-X) > ' '
                       SET W0001-LINES-SELECTED  TO TRUE
                       MOVE WS-M-F-BKID-C (W0001-X)
                         TO M-BKID-CBI
                       MOVE WS-M-F-BKID-X (W0001-X)
                         TO M-BKID-XBI
                       MOVE W0001-X              TO WS-M-INDEX
                   END-IF
           END-PERFORM.

           IF  W0001-LINES-SELECTED
               SET MAP-B-ACTIVE    TO TRUE
               MOVE W9999-MSG-019  TO M-MSG-22BI
               MOVE -1             TO M-BKID-XBL
           ELSE
               MOVE W9999-MSG-045  TO M-MSG-22I
               SET ERRORS          TO TRUE
               MOVE -1             TO M-ACT-CL (1)
           END-IF.

           EJECT
       B000-PROCESS-ENTER-KEY.

           MOVE 'B000'      TO CA-PARAGRAPH-NBR.

           SET W0001-NO-LINES-SELECTED TO TRUE.

           IF  M-BOOKKEY-CI > SPACES
               PERFORM B100-VALIDATE-KEY
           ELSE
               PERFORM B300-CHECK-FOR-SELECTION
               IF  NO-ERRORS
                   IF  W0001-LINES-SELECTED
                       CONTINUE
                   ELSE
                       MOVE W9999-MSG-001  TO M-MSG-22I
                       SET ERRORS          TO TRUE
                       MOVE -1             TO M-BOOKKEY-CL
                   END-IF
               END-IF
           END-IF.

           EJECT
       B100-VALIDATE-KEY.

           MOVE 'B100'      TO CA-PARAGRAPH-NBR.

           MOVE CA-CURR-F-DSID-C  TO F-DSID-C    IN DCLT231DSBK.
           MOVE CA-CURR-F-DSID-N  TO F-DSLN-N    IN DCLT231DSBK.
           MOVE M-BOOKKEY-CI      TO F-BKID-C  IN DCLT231DSBK.

           EXEC SQL
                OPEN CSR_3
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           EXEC SQL
                FETCH CSR_3
                 INTO :DCLT231DSBK.F-BKID-C
           END-EXEC.

           PERFORM Z900-DB2-CHECK

           IF  DB2-NORMAL
               MOVE F-BKID-C IN DCLT231DSBK TO CA-CURR-F-BKID-C
                                                 M-BOOKKEY-CI
               PERFORM C300-GET-BOOK-DESC
               MOVE SPACES                    TO M-BOOKKEY-CI
               MOVE F-BKID-X   IN DCLT231BOOK TO CA-CURR-F-BKID-X
               SET W0001-LINES-SELECTED       TO TRUE
           ELSE
               MOVE SPACES         TO F-BKID-X IN DCLT231BOOK
               MOVE W9999-MSG-035  TO M-MSG-22I
               SET ERRORS          TO TRUE
               MOVE -1             TO M-BOOKKEY-CL
           END-IF.

           EXEC SQL
               CLOSE CSR_3
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           EJECT
       B300-CHECK-FOR-SELECTION.

           MOVE 'B300'      TO CA-PARAGRAPH-NBR.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-LINE-LIMIT
                OR W0001-LINES-SELECTED
                   IF  M-ACT-CI (W0001-X) > ' '
                       SET W0001-LINES-SELECTED TO TRUE
                       MOVE M-BKID-CI (W0001-X)
                         TO CA-CURR-F-BKID-C
                       MOVE M-BKID-XI (W0001-X)
                         TO CA-CURR-F-BKID-X
                   END-IF
           END-PERFORM.

           EJECT
       B400-DISPLAY-SCREEN-1.

           MOVE 'B400'      TO CA-PARAGRAPH-NBR.

           PERFORM VARYING W0001-IX FROM 1 BY 1
             UNTIL W0001-IX > W0001-SCREEN-LINE-LIMIT
              MOVE WS-M-F-BKID-C  (W0001-IX)
                TO M-BKID-CI      (W0001-IX)
              MOVE WS-M-F-BKID-X  (W0001-IX)
                TO M-BKID-XI      (W0001-IX)
              MOVE WS-M-A-CPYP1-N (W0001-IX)
                TO M-CPYP1-NI     (W0001-IX)
              MOVE WS-M-A-CPYP2-N (W0001-IX)
                TO M-CPYP2-NI     (W0001-IX)
              MOVE WS-M-A-CPYFN-N (W0001-IX)
                TO M-CPYFN-NI     (W0001-IX)
              MOVE WS-M-A-CPYQ1-N (W0001-IX)
                TO M-CPYQ1-NI     (W0001-IX)
              MOVE WS-M-A-CPYQ2-N (W0001-IX)
                TO M-CPYQ2-NI     (W0001-IX)
              MOVE WS-M-A-CPYQ3-N (W0001-IX)
                TO M-CPYQ3-NI     (W0001-IX)
              MOVE WS-M-A-CPYQN-N (W0001-IX)
                TO M-CPYQN-NI     (W0001-IX)
           END-PERFORM.

           IF  NO-ERRORS
               MOVE W9999-MSG-001  TO M-MSG-22I
               MOVE -1             TO M-BOOKKEY-CL
           END-IF.

           EJECT
       C000-PROCESS-NEXT-PAGE.

           MOVE 'C000'      TO CA-PARAGRAPH-NBR.

           IF  NO-ERRORS
               PERFORM C200-GET-T231DSBK
               IF  W0001-IX > 1 AND <= W0001-SCREEN-LINE-LIMIT
                   PERFORM UNTIL W0001-IX > W0001-SCREEN-LINE-LIMIT
                       PERFORM C400-MOVE-BLANKS-TO-SCREEN
                       ADD +1 TO W0001-IX
                   END-PERFORM
               ELSE
                   IF  W0001-IX = 1 AND EIBAID = DFHENTER
                       PERFORM VARYING W0001-IX FROM 1 BY 1
                         UNTIL W0001-IX > W0001-SCREEN-LINE-LIMIT
                           PERFORM C400-MOVE-BLANKS-TO-SCREEN
                       END-PERFORM
                   END-IF
               END-IF
           ELSE
               PERFORM VARYING W0001-IX FROM 1 BY 1
                 UNTIL W0001-IX > W0001-SCREEN-LINE-LIMIT
                   PERFORM C400-MOVE-BLANKS-TO-SCREEN
               END-PERFORM
           END-IF.

           EJECT
       C200-GET-T231DSBK.

           MOVE 'C200'      TO CA-PARAGRAPH-NBR.

           MOVE CA-CURR-F-DSID-C  TO F-DSID-C    IN DCLT231DSBK.
           MOVE CA-CURR-F-DSID-N  TO F-DSLN-N    IN DCLT231DSBK.
           MOVE WS-M-MAX-BKID-C   TO F-BKID-C    IN DCLT231DSBK.

           EXEC SQL
                OPEN CSR_1
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           MOVE +1 TO W0001-IX.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO
                      OR W0001-IX > W0001-SCREEN-LINE-LIMIT
               EXEC SQL
                    FETCH CSR_1
                     INTO :DCLT231DSBK.F-BKID-C
                        , :DCLT231DSBK.A-CPYP1-N
                        , :DCLT231DSBK.A-CPYP2-N
                        , :DCLT231DSBK.A-CPYFN-N
                        , :DCLT231DSBK.A-CPYQ1-N
                        , :DCLT231DSBK.A-CPYQ2-N
                        , :DCLT231DSBK.A-CPYQ3-N
                        , :DCLT231DSBK.A-CPYQN-N
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   IF  W0001-IX = 1
                       MOVE F-BKID-C          IN DCLT231DSBK
                         TO WS-M-MIN-BKID-C
                   END-IF

                   MOVE F-BKID-C          IN DCLT231DSBK
                     TO M-BKID-CI         (W0001-IX)
                        M-BOOKKEY-CI
                        WS-M-F-BKID-C     (W0001-IX)

                   PERFORM C300-GET-BOOK-DESC
                   MOVE SPACES
                     TO M-BOOKKEY-CI

                   MOVE F-BKID-X          IN DCLT231BOOK
                     TO M-BKID-XI         (W0001-IX)
                        WS-M-F-BKID-X     (W0001-IX)

                   MOVE A-CPYP1-N         IN DCLT231DSBK
                     TO M-CPYP1-NI        (W0001-IX)
                        WS-M-A-CPYP1-N    (W0001-IX)
                   MOVE A-CPYP2-N         IN DCLT231DSBK
                     TO M-CPYP2-NI        (W0001-IX)
                        WS-M-A-CPYP2-N    (W0001-IX)
                   MOVE A-CPYFN-N         IN DCLT231DSBK
                     TO M-CPYFN-NI        (W0001-IX)
                        WS-M-A-CPYFN-N    (W0001-IX)
                   MOVE A-CPYQ1-N         IN DCLT231DSBK
                     TO M-CPYQ1-NI        (W0001-IX)
                        WS-M-A-CPYQ1-N    (W0001-IX)
                   MOVE A-CPYQ2-N         IN DCLT231DSBK
                     TO M-CPYQ2-NI        (W0001-IX)
                        WS-M-A-CPYQ2-N    (W0001-IX)
                   MOVE A-CPYQ3-N         IN DCLT231DSBK
                     TO M-CPYQ3-NI        (W0001-IX)
                        WS-M-A-CPYQ3-N    (W0001-IX)
                   MOVE A-CPYQN-N         IN DCLT231DSBK
                     TO M-CPYQN-NI        (W0001-IX)
                        WS-M-A-CPYQN-N    (W0001-IX)

                   ADD +1 TO W0001-IX
               END-IF
           END-PERFORM.

           MOVE F-BKID-C          IN DCLT231DSBK
             TO WS-M-MAX-BKID-C.

           IF  DB2-END-OF-FILE
               MOVE W9999-MSG-004  TO M-MSG-22I
               SET ERRORS          TO TRUE
               MOVE -1             TO M-BOOKKEY-CL
           END-IF.

           EXEC SQL
               CLOSE CSR_1
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           IF  NO-ERRORS
               MOVE W9999-MSG-001  TO M-MSG-22I
               MOVE -1             TO M-BOOKKEY-CL
           END-IF.

           EJECT
       C300-GET-BOOK-DESC.

           MOVE 'C300'      TO CA-PARAGRAPH-NBR.

           MOVE M-BOOKKEY-CI     TO F-BKID-C    IN DCLT231BOOK.

           EXEC SQL
                OPEN CSR_4
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           EXEC SQL
                FETCH CSR_4
                 INTO :DCLT231BOOK.F-BKID-X
                    , :DCLT231BOOK.DB-RECTYP-C
                    , :DCLT231BOOK.A-SEQ-N
           END-EXEC.

           PERFORM Z900-DB2-CHECK

           IF  DB2-NORMAL
               MOVE F-BKID-X IN DCLT231BOOK TO CA-CURR-F-BKID-X
               SET W0001-LINES-SELECTED     TO TRUE
           ELSE
               MOVE SPACES                  TO F-BKID-X IN DCLT231BOOK
           END-IF.

           EXEC SQL
               CLOSE CSR_4
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           EJECT
       C400-MOVE-BLANKS-TO-SCREEN.

           MOVE 'C400'      TO CA-PARAGRAPH-NBR.

           MOVE SPACES TO M-ACT-CI       (W0001-IX)
                          M-BKID-CI      (W0001-IX)
                          M-BKID-XI      (W0001-IX)
                          M-CPYP1-NI     (W0001-IX)
                          M-CPYP2-NI     (W0001-IX)
                          M-CPYFN-NI     (W0001-IX)
                          M-CPYQ1-NI     (W0001-IX)
                          M-CPYQ2-NI     (W0001-IX)
                          M-CPYQ3-NI     (W0001-IX)
                          M-CPYQN-NI     (W0001-IX)
                          WS-M-F-BKID-C  (W0001-IX)
                          WS-M-F-BKID-X  (W0001-IX)
                          WS-M-A-CPYP1-N (W0001-IX)
                          WS-M-A-CPYP2-N (W0001-IX)
                          WS-M-A-CPYFN-N (W0001-IX)
                          WS-M-A-CPYQ1-N (W0001-IX)
                          WS-M-A-CPYQ2-N (W0001-IX)
                          WS-M-A-CPYQ3-N (W0001-IX)
                          WS-M-A-CPYQN-N (W0001-IX).

           EJECT
       D000-PROCESS-PREV-PAGE.

           MOVE 'D000'      TO CA-PARAGRAPH-NBR.

           IF  NO-ERRORS
               PERFORM D200-GET-T231DSBK
               IF  W0001-IX >= 1 AND < W0001-SCREEN-LINE-LIMIT
                   PERFORM UNTIL W0001-IX < 1
                       PERFORM C400-MOVE-BLANKS-TO-SCREEN
                       SUBTRACT +1 FROM W0001-IX
                   END-PERFORM
               END-IF
           ELSE
               PERFORM VARYING W0001-IX FROM 1 BY 1
                 UNTIL W0001-IX > W0001-SCREEN-LINE-LIMIT
                   PERFORM C400-MOVE-BLANKS-TO-SCREEN
               END-PERFORM
           END-IF.

           IF  NO-ERRORS
               MOVE -1            TO M-BOOKKEY-CL
               MOVE W9999-MSG-003 TO M-MSG-22I
           END-IF.

           EJECT
       D200-GET-T231DSBK.

           MOVE 'D200'      TO CA-PARAGRAPH-NBR.

           MOVE CA-CURR-F-DSID-C  TO F-DSID-C    IN DCLT231DSBK.
           MOVE CA-CURR-F-DSID-N  TO F-DSLN-N    IN DCLT231DSBK.
           MOVE WS-M-MIN-BKID-C   TO F-BKID-C    IN DCLT231DSBK.

           EXEC SQL
                OPEN CSR_2
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           MOVE W0001-SCREEN-LINE-LIMIT TO W0001-IX.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO
                      OR W0001-IX < 1
               EXEC SQL
                    FETCH CSR_2
                     INTO :DCLT231DSBK.F-BKID-C
                        , :DCLT231DSBK.A-CPYP1-N
                        , :DCLT231DSBK.A-CPYP2-N
                        , :DCLT231DSBK.A-CPYFN-N
                        , :DCLT231DSBK.A-CPYQ1-N
                        , :DCLT231DSBK.A-CPYQ2-N
                        , :DCLT231DSBK.A-CPYQ3-N
                        , :DCLT231DSBK.A-CPYQN-N
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   MOVE F-BKID-C          IN DCLT231DSBK
                     TO M-BKID-CI         (W0001-IX)
                        M-BOOKKEY-CI
                        WS-M-F-BKID-C     (W0001-IX)

                   PERFORM C300-GET-BOOK-DESC
                   MOVE SPACES
                     TO M-BOOKKEY-CI

                   MOVE F-BKID-X          IN DCLT231BOOK
                     TO M-BKID-XI         (W0001-IX)
                        WS-M-F-BKID-X     (W0001-IX)

                   MOVE A-CPYP1-N         IN DCLT231DSBK
                     TO M-CPYP1-NI        (W0001-IX)
                        WS-M-A-CPYP1-N    (W0001-IX)
                   MOVE A-CPYP2-N         IN DCLT231DSBK
                     TO M-CPYP2-NI        (W0001-IX)
                        WS-M-A-CPYP2-N    (W0001-IX)
                   MOVE A-CPYFN-N         IN DCLT231DSBK
                     TO M-CPYFN-NI        (W0001-IX)
                        WS-M-A-CPYFN-N    (W0001-IX)
                   MOVE A-CPYQ1-N         IN DCLT231DSBK
                     TO M-CPYQ1-NI        (W0001-IX)
                        WS-M-A-CPYQ1-N    (W0001-IX)
                   MOVE A-CPYQ2-N         IN DCLT231DSBK
                     TO M-CPYQ2-NI        (W0001-IX)
                        WS-M-A-CPYQ2-N    (W0001-IX)
                   MOVE A-CPYQ3-N         IN DCLT231DSBK
                     TO M-CPYQ3-NI        (W0001-IX)
                        WS-M-A-CPYQ3-N    (W0001-IX)
                   MOVE A-CPYQN-N         IN DCLT231DSBK
                     TO M-CPYQN-NI        (W0001-IX)
                        WS-M-A-CPYQN-N    (W0001-IX)

                   IF  W0001-IX = W0001-SCREEN-LINE-LIMIT
                       MOVE F-BKID-C          IN DCLT231DSBK
                         TO WS-M-MAX-BKID-C
                   END-IF

                   SUBTRACT +1 FROM W0001-IX
               END-IF
           END-PERFORM.

           MOVE F-BKID-C          IN DCLT231DSBK
             TO WS-M-MIN-BKID-C.

           IF  DB2-END-OF-FILE
               MOVE W9999-MSG-005  TO M-MSG-22I
               SET ERRORS          TO TRUE
               MOVE -1             TO M-BOOKKEY-CL
           END-IF.

           EXEC SQL
               CLOSE CSR_2
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           IF  NO-ERRORS
               MOVE W9999-MSG-001  TO M-MSG-22I
               MOVE -1             TO M-BOOKKEY-CL
           END-IF.

           EJECT
       E000-PROCESS-NEXT-PAGE.

           MOVE 'E000'      TO CA-PARAGRAPH-NBR.

           IF  NO-ERRORS
               PERFORM E200-GET-T231BOOK-LINES

               IF  W0001-IX > 1 AND <= W0001-SCREEN-A-LN-LIMIT
                   PERFORM UNTIL W0001-IX > W0001-SCREEN-A-LN-LIMIT
                       PERFORM E400-MOVE-BLANKS-TO-SCREEN
                       ADD +1 TO W0001-IX
                   END-PERFORM
               ELSE
                   IF  W0001-IX = 1 AND EIBAID = DFHENTER
                       PERFORM VARYING W0001-IX FROM 1 BY 1
                         UNTIL W0001-IX > W0001-SCREEN-A-LN-LIMIT
                           PERFORM E400-MOVE-BLANKS-TO-SCREEN
                       END-PERFORM
                   END-IF
               END-IF
           ELSE
               PERFORM VARYING W0001-IX FROM 1 BY 1
                 UNTIL W0001-IX > W0001-SCREEN-A-LN-LIMIT
                   PERFORM E400-MOVE-BLANKS-TO-SCREEN
               END-PERFORM
           END-IF.

           EJECT
       E100-PROCESS-ENTER-KEY.

           MOVE 'E000'      TO CA-PARAGRAPH-NBR.

           IF  M-BOOKKEY-CAI > SPACES
               MOVE M-BOOKKEY-CAI TO F-BKID-C     IN DCLT231BOOK
                                    WS-M-A-MAX-BKID-C
               MOVE SPACES       TO F-RPTGRP-C    IN DCLT231BOOK
                                    WS-M-A-MAX-RPTGRP-C
               MOVE ZEROES       TO A-SEQ-N       IN DCLT231BOOK
                                    WS-M-A-MAX-SEQ-N

               PERFORM E000-PROCESS-NEXT-PAGE

               MOVE SPACES TO M-BOOKKEY-CAI
           END-IF.

           IF  NO-ERRORS
               MOVE W9999-MSG-001  TO M-MSG-22AI
               MOVE -1             TO M-BOOKKEY-CAL
           END-IF.

           EJECT
       E200-GET-T231BOOK-LINES.

           MOVE 'E200'      TO CA-PARAGRAPH-NBR.

           MOVE WS-M-A-MAX-BKID-C   TO F-BKID-C     IN DCLT231BOOK.
           MOVE WS-M-A-MAX-RPTGRP-C TO F-RPTGRP-C   IN DCLT231BOOK.
           MOVE WS-M-A-MAX-SEQ-N    TO A-SEQ-N      IN DCLT231BOOK.
           MOVE CA-OP-ID            TO A-UID-C      IN DCLT231SEC.

           EXEC SQL
                OPEN CSR_5
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           MOVE +1 TO W0001-IX.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO
                      OR W0001-IX > W0001-SCREEN-A-LN-LIMIT
               EXEC SQL
                    FETCH CSR_5
                     INTO :DCLT231BOOK.F-BKID-C
                        , :DCLT231BOOK.F-RPTGRP-C
                        , :DCLT231BOOK.A-SEQ-N
                        , :DCLT231BOOK.DB-RECTYP-C
                        , :DCLT231BOOK.F-BKID-X
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   IF  W0001-IX = 1
                       MOVE F-BKID-C     IN DCLT231BOOK
                         TO WS-M-A-MIN-BKID-C
                       MOVE F-RPTGRP-C   IN DCLT231BOOK
                         TO WS-M-A-MIN-RPTGRP-C
                       MOVE A-SEQ-N      IN DCLT231BOOK
                         TO WS-M-A-MIN-SEQ-N
                   END-IF
                   MOVE F-BKID-C          IN DCLT231BOOK
                     TO M-BKID-CAI        (W0001-IX)
                        WS-M-A-F-BKID-C   (W0001-IX)
                   MOVE F-RPTGRP-C        IN DCLT231BOOK
                     TO WS-M-A-F-RPTGRP-C (W0001-IX)
                   MOVE A-SEQ-N           IN DCLT231BOOK
                     TO WS-M-A-A-SEQ-N    (W0001-IX)
                   MOVE F-BKID-X          IN DCLT231BOOK
                     TO M-BKID-XAI        (W0001-IX)
                        WS-M-A-F-BKID-X   (W0001-IX)

                   ADD +1 TO W0001-IX
               END-IF
           END-PERFORM.

           MOVE F-BKID-C     IN DCLT231BOOK
             TO WS-M-A-MAX-BKID-C.
           MOVE F-RPTGRP-C   IN DCLT231BOOK
             TO WS-M-A-MAX-RPTGRP-C.
           MOVE A-SEQ-N      IN DCLT231BOOK
             TO WS-M-A-MAX-SEQ-N.

           IF  DB2-END-OF-FILE
               MOVE W9999-MSG-004  TO M-MSG-22AI
               SET ERRORS          TO TRUE
               MOVE -1             TO M-BOOKKEY-CAL
           END-IF.

           EXEC SQL
               CLOSE CSR_5
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           IF  NO-ERRORS
               MOVE W9999-MSG-001  TO M-MSG-22AI
               MOVE -1             TO M-BOOKKEY-CAL
           END-IF.

           EJECT
       E400-MOVE-BLANKS-TO-SCREEN.

           MOVE 'E400'      TO CA-PARAGRAPH-NBR.

           MOVE SPACES TO M-ACT-CAI      (W0001-IX)
                          M-BKID-CAI     (W0001-IX)
                          M-BKID-XAI     (W0001-IX).

           EJECT
       F000-PROCESS-PREV-PAGE.

           MOVE 'F000'      TO CA-PARAGRAPH-NBR.

           IF  NO-ERRORS
               PERFORM F200-GET-T231BOOK-LINES

               IF  W0001-IX >= 1 AND < W0001-SCREEN-A-LN-LIMIT
                   PERFORM UNTIL W0001-IX < 1
                       PERFORM E400-MOVE-BLANKS-TO-SCREEN
                       SUBTRACT +1 FROM W0001-IX
                   END-PERFORM
               END-IF
           ELSE
               PERFORM VARYING W0001-IX FROM 1 BY 1
                 UNTIL W0001-IX > W0001-SCREEN-A-LN-LIMIT
                   PERFORM E400-MOVE-BLANKS-TO-SCREEN
               END-PERFORM
           END-IF.

           IF  NO-ERRORS
               MOVE -1            TO M-ACT-CAL(1)
               MOVE W9999-MSG-003 TO M-MSG-22AI
           END-IF.

           EJECT
       F200-GET-T231BOOK-LINES.

           MOVE 'D200'      TO CA-PARAGRAPH-NBR.

           MOVE WS-M-A-MIN-BKID-C   TO F-BKID-C     IN DCLT231BOOK.
           MOVE WS-M-A-MIN-RPTGRP-C TO F-RPTGRP-C   IN DCLT231BOOK.
           MOVE WS-M-A-MIN-SEQ-N    TO A-SEQ-N      IN DCLT231BOOK.
           MOVE CA-OP-ID            TO A-UID-C      IN DCLT231SEC.

           EXEC SQL
                OPEN CSR_6
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           MOVE W0001-SCREEN-A-LN-LIMIT TO W0001-IX.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO
                      OR W0001-IX < 1
               EXEC SQL
                    FETCH CSR_6
                     INTO :DCLT231BOOK.F-BKID-C
                        , :DCLT231BOOK.F-RPTGRP-C
                        , :DCLT231BOOK.A-SEQ-N
                        , :DCLT231BOOK.DB-RECTYP-C
                        , :DCLT231BOOK.F-BKID-X
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   MOVE F-BKID-C          IN DCLT231BOOK
                     TO M-BKID-CAI        (W0001-IX)
                        WS-M-A-F-BKID-C   (W0001-IX)
                   MOVE F-RPTGRP-C        IN DCLT231BOOK
                     TO WS-M-A-F-RPTGRP-C (W0001-IX)
                   MOVE A-SEQ-N           IN DCLT231BOOK
                     TO WS-M-A-A-SEQ-N    (W0001-IX)
                   MOVE F-BKID-X          IN DCLT231BOOK
                     TO M-BKID-XAI        (W0001-IX)
                        WS-M-A-F-BKID-X   (W0001-IX)

                   IF  W0001-IX = W0001-SCREEN-A-LN-LIMIT
                       MOVE F-BKID-C     IN DCLT231BOOK
                         TO WS-M-A-MAX-BKID-C
                       MOVE F-RPTGRP-C   IN DCLT231BOOK
                         TO WS-M-A-MAX-RPTGRP-C
                       MOVE A-SEQ-N      IN DCLT231BOOK
                         TO WS-M-A-MAX-SEQ-N
                   END-IF

                   SUBTRACT +1 FROM W0001-IX
               END-IF
           END-PERFORM.

           MOVE F-BKID-C     IN DCLT231BOOK
             TO WS-M-A-MIN-BKID-C.
           MOVE F-RPTGRP-C   IN DCLT231BOOK
             TO WS-M-A-MIN-RPTGRP-C.
           MOVE A-SEQ-N      IN DCLT231BOOK
             TO WS-M-A-MIN-SEQ-N.

           IF  DB2-END-OF-FILE
               MOVE W9999-MSG-005  TO M-MSG-22AI
               SET ERRORS          TO TRUE
               MOVE -1             TO M-BOOKKEY-CAL
           END-IF.

           EXEC SQL
               CLOSE CSR_6
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           IF  NO-ERRORS
               MOVE W9999-MSG-001  TO M-MSG-22AI
               MOVE -1             TO M-BOOKKEY-CAL
           END-IF.

           EJECT
       G000-ADD-BOOK-TO-DIST.

           MOVE 'G000'      TO CA-PARAGRAPH-NBR.

           IF  M-BOOKKEY-CI > SPACES
               PERFORM G010-VALIDATE-BOOK-ID
               IF  W0001-LINES-SELECTED
                   PERFORM G200-INSERT-T231DSBK-LINE
               ELSE
      *BWM* CHECK FOR MAXIMUN NUMBER OF BOOKS.
      *BWM* CHECK TO SEE IF BOOK EXISTS
      *BWM*        MOVE W9999-MSG-053  TO M-MSG-22I
      *BWM*        MOVE -1             TO M-BOOKKEY-CL
      *BWM*        SET ERRORS          TO TRUE
                   MOVE W9999-MSG-027  TO M-MSG-22I
                   MOVE -1             TO M-BOOKKEY-CL
                   SET ERRORS          TO TRUE
               END-IF
           ELSE
               MOVE W9999-MSG-054  TO M-MSG-22I
               MOVE -1             TO M-BOOKKEY-CL
               SET ERRORS          TO TRUE
           END-IF.

           IF  NO-ERRORS
               MOVE W9999-MSG-012  TO M-MSG-22I
               MOVE -1             TO M-BOOKKEY-CL
               MOVE SPACES         TO M-BOOKKEY-CI
           END-IF.

           EJECT
       G010-VALIDATE-BOOK-ID.

           MOVE 'G010'      TO CA-PARAGRAPH-NBR.

           MOVE M-BOOKKEY-CI     TO F-BKID-C    IN DCLT231BOOK.
           MOVE CA-OP-ID         TO A-UID-C     IN DCLT231SEC.

           SET W0001-NO-LINES-SELECTED TO TRUE.

           EXEC SQL
                SELECT F_BKID_X
                     , DB_RECTYP_C
                     , A_SEQ_N
                 INTO :DCLT231BOOK.F-BKID-X
                    , :DCLT231BOOK.DB-RECTYP-C
                    , :DCLT231BOOK.A-SEQ-N
                  FROM D231.T231BOOK
                 WHERE F_BKID_C     = :DCLT231BOOK.F-BKID-C
                   AND F_RPTGRP_C   = '   '
                   AND DB_RECTYP_C  = '/'
                   AND A_SEQ_N      = +1
                   AND ( SUBSTR(F_BKID_C,1,2) IN
                         (SELECT DISTINCT SUBSTR(F_AFM_C,1,2)
                            FROM D231.T231SEC A
                           WHERE A.A_UID_C     = :DCLT231SEC.A-UID-C
                             AND A.DB_RECTYP_C = 'B')
                       OR EXISTS
                        ( SELECT *
                            FROM D231.T231ACS B
                           WHERE B.A_UID_C    = :DCLT231SEC.A-UID-C
                             AND B.A_UIDTYP_C = 'C')
                       )
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           IF  DB2-NORMAL
               SET W0001-LINES-SELECTED     TO TRUE
           END-IF.

           EJECT
       G100-UPDATE-T231DSBK-LINE.

           MOVE 'G100'      TO CA-PARAGRAPH-NBR.

           MOVE CA-CURR-F-DSID-C  TO F-DSID-C    IN DCLT231DSBK.
           MOVE CA-CURR-F-DSID-N  TO F-DSLN-N    IN DCLT231DSBK.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-LINE-LIMIT
                OR W0001-LINES-SELECTED
                OR ERRORS
                   IF  M-BKID-CI (W0001-X) > ' '
                       MOVE SPACES
                         TO M-ACT-CI   (W0001-X)
                       MOVE M-BKID-CI  (W0001-X)
                         TO F-BKID-C     IN DCLT231DSBK
                       MOVE M-CPYP1-NI (W0001-X)
                         TO A-CPYP1-N    IN DCLT231DSBK
                       MOVE M-CPYP2-NI (W0001-X)
                         TO A-CPYP2-N    IN DCLT231DSBK
                       MOVE M-CPYFN-NI (W0001-X)
                         TO A-CPYFN-N    IN DCLT231DSBK
                       MOVE M-CPYQ1-NI (W0001-X)
                         TO A-CPYQ1-N    IN DCLT231DSBK
                       MOVE M-CPYQ2-NI (W0001-X)
                         TO A-CPYQ2-N    IN DCLT231DSBK
                       MOVE M-CPYQ3-NI (W0001-X)
                         TO A-CPYQ3-N    IN DCLT231DSBK
                       MOVE M-CPYQN-NI (W0001-X)
                         TO A-CPYQN-N    IN DCLT231DSBK
                       MOVE CA-OP-ID
                         TO DB-UPD-X    IN DCLT231DSBK
                       PERFORM G110-VALIDATE-NBR-OF-COPIES
                       IF  NO-ERRORS
                           PERFORM G120-UPDATE-T231DSBK
                       END-IF
                   END-IF
           END-PERFORM.

           IF  NO-ERRORS
               MOVE W9999-MSG-013  TO M-MSG-22I
               SET ERRORS          TO TRUE
               MOVE -1             TO M-ACT-CL (1)
           END-IF.

           EJECT
       G110-VALIDATE-NBR-OF-COPIES.

           MOVE 'G110'      TO CA-PARAGRAPH-NBR.

           IF  M-CPYP1-NI  (W0001-X) > '  '
               IF  M-CPYP1-NI  (W0001-X) < '01'
               OR  M-CPYP1-NI  (W0001-X) > '30'
               OR  M-CPYP1-NI  (W0001-X) IS NOT NUMERIC
                   MOVE W9999-MSG-062 TO M-MSG-22I
                   MOVE -1            TO M-CPYP1-NL (W0001-X)
                   SET ERRORS         TO TRUE
               END-IF
           END-IF.

           IF  M-CPYP2-NI  (W0001-X) > '  '
               IF  M-CPYP2-NI  (W0001-X) < '01'
               OR  M-CPYP2-NI  (W0001-X) > '30'
               OR  M-CPYP2-NI  (W0001-X) IS NOT NUMERIC
                   MOVE W9999-MSG-062 TO M-MSG-22I
                   MOVE -1            TO M-CPYP2-NL (W0001-X)
                   SET ERRORS         TO TRUE
               END-IF
           END-IF.

           IF  M-CPYFN-NI  (W0001-X) > '  '
               IF  M-CPYFN-NI  (W0001-X) < '01'
               OR  M-CPYFN-NI  (W0001-X) > '30'
               OR  M-CPYFN-NI  (W0001-X) IS NOT NUMERIC
                   MOVE W9999-MSG-062 TO M-MSG-22I
                   MOVE -1            TO M-CPYFN-NL (W0001-X)
                   SET ERRORS         TO TRUE
               END-IF
           END-IF.

           IF  M-CPYQ1-NI  (W0001-X) > '  '
               IF  M-CPYQ1-NI  (W0001-X) < '01'
               OR  M-CPYQ1-NI  (W0001-X) > '30'
               OR  M-CPYQ1-NI  (W0001-X) IS NOT NUMERIC
                   MOVE W9999-MSG-062 TO M-MSG-22I
                   MOVE -1            TO M-CPYQ1-NL (W0001-X)
                   SET ERRORS         TO TRUE
               END-IF
           END-IF.

           IF  M-CPYQ2-NI  (W0001-X) > '  '
               IF  M-CPYQ2-NI  (W0001-X) < '01'
               OR  M-CPYQ2-NI  (W0001-X) > '30'
               OR  M-CPYQ2-NI  (W0001-X) IS NOT NUMERIC
                   MOVE W9999-MSG-062 TO M-MSG-22I
                   MOVE -1            TO M-CPYQ2-NL (W0001-X)
                   SET ERRORS         TO TRUE
               END-IF
           END-IF.

           IF  M-CPYQ3-NI  (W0001-X) > '  '
               IF  M-CPYQ3-NI  (W0001-X) < '01'
               OR  M-CPYQ3-NI  (W0001-X) > '30'
               OR  M-CPYQ3-NI  (W0001-X) IS NOT NUMERIC
                   MOVE W9999-MSG-062 TO M-MSG-22I
                   MOVE -1            TO M-CPYQ3-NL (W0001-X)
                   SET ERRORS         TO TRUE
               END-IF
           END-IF.

           IF  M-CPYQN-NI  (W0001-X) > '  '
               IF  M-CPYQN-NI  (W0001-X) < '01'
               OR  M-CPYQN-NI  (W0001-X) > '30'
               OR  M-CPYQN-NI  (W0001-X) IS NOT NUMERIC
                   MOVE W9999-MSG-062 TO M-MSG-22I
                   MOVE -1            TO M-CPYQN-NL (W0001-X)
                   SET ERRORS         TO TRUE
               END-IF
           END-IF.

           EJECT
       G120-UPDATE-T231DSBK.

           MOVE 'G120'      TO CA-PARAGRAPH-NBR.

           EXEC SQL
                UPDATE D231.T231DSBK
                   SET A_CPYP1_N    =  :DCLT231DSBK.A-CPYP1-N
                     , A_CPYP2_N    =  :DCLT231DSBK.A-CPYP2-N
                     , A_CPYFN_N    =  :DCLT231DSBK.A-CPYFN-N
                     , A_CPYQ1_N    =  :DCLT231DSBK.A-CPYQ1-N
                     , A_CPYQ2_N    =  :DCLT231DSBK.A-CPYQ2-N
                     , A_CPYQ3_N    =  :DCLT231DSBK.A-CPYQ3-N
                     , A_CPYQN_N    =  :DCLT231DSBK.A-CPYQN-N
                     , DB_UPD_D     =  CURRENT DATE
                     , DB_UPD_T     =  CURRENT TIME
                     , DB_UPD_X     =  :DCLT231DSBK.DB-UPD-X
                 WHERE F_DSID_C     =  :DCLT231DSBK.F-DSID-C
                   AND F_DSLN_N     =  :DCLT231DSBK.F-DSLN-N
                   AND F_BKID_C     =  :DCLT231DSBK.F-BKID-C
           END-EXEC.

           EJECT
       G200-INSERT-T231DSBK-LINE.

           MOVE 'G200'      TO CA-PARAGRAPH-NBR.

           INITIALIZE DCLT231DSBK.

           MOVE CA-CURR-F-DSID-C  TO F-DSID-C    IN DCLT231DSBK.
           MOVE CA-CURR-F-DSID-N  TO F-DSLN-N    IN DCLT231DSBK.

           MOVE M-BOOKKEY-CI TO F-BKID-C    IN DCLT231DSBK.
           MOVE '01'         TO A-CPYP1-N   IN DCLT231DSBK.
           MOVE '01'         TO A-CPYP2-N   IN DCLT231DSBK.
           MOVE '01'         TO A-CPYFN-N   IN DCLT231DSBK.
           MOVE '01'         TO A-CPYQ1-N   IN DCLT231DSBK.
           MOVE '01'         TO A-CPYQ2-N   IN DCLT231DSBK.
           MOVE '01'         TO A-CPYQ3-N   IN DCLT231DSBK.
           MOVE '01'         TO A-CPYQN-N   IN DCLT231DSBK.
           MOVE CA-OP-ID     TO DB-UPD-X    IN DCLT231DSBK.

           EXEC SQL
             INSERT INTO D231.T231DSBK
                 ( F_DSID_C
                 , F_DSLN_N
                 , F_BKID_C
                 , A_CPYP1_N
                 , A_CPYP2_N
                 , A_CPYFN_N
                 , A_CPYQ1_N
                 , A_CPYQ2_N
                 , A_CPYQ3_N
                 , A_CPYQN_N
                 , DB_UPD_D
                 , DB_UPD_T
                 , DB_UPD_X )
             VALUES
                 ( :DCLT231DSBK.F-DSID-C
                 , :DCLT231DSBK.F-DSLN-N
                 , :DCLT231DSBK.F-BKID-C
                 , :DCLT231DSBK.A-CPYP1-N
                 , :DCLT231DSBK.A-CPYP2-N
                 , :DCLT231DSBK.A-CPYFN-N
                 , :DCLT231DSBK.A-CPYQ1-N
                 , :DCLT231DSBK.A-CPYQ2-N
                 , :DCLT231DSBK.A-CPYQ3-N
                 , :DCLT231DSBK.A-CPYQN-N
                 , CURRENT DATE
                 , CURRENT TIME
                 , :DCLT231DSBK.DB-UPD-X )
           END-EXEC.

           SET DUP-KEY  TO TRUE.
           PERFORM Z900-DB2-CHECK.


           EJECT
       H000-COPY-TO-NEW-BOOK.

           MOVE 'H000'      TO CA-PARAGRAPH-NBR.

           PERFORM H100-VALIDATE-KEYS.

           IF  NO-ERRORS
               PERFORM H200-PROCESS-COPY-CURSOR
               IF  NO-ERRORS
                   CONTINUE
               ELSE
                   PERFORM Y600-ROLLBACK
                   SET ERRORS          TO TRUE
                   MOVE -1             TO M-BOOKKEY-CL
                   MOVE W9999-MSG-050  TO M-MSG-22I
               END-IF
           END-IF.

           IF  NO-ERRORS
               MOVE -1             TO M-BOOKKEY-CL
               MOVE W9999-MSG-020  TO M-MSG-22I
               INITIALIZE             WS-M-MIN-VALUES
               MOVE M-BOOKKEY-CI   TO WS-M-MIN-BKID-C
               MOVE SPACES         TO M-ACT-CI (WS-M-INDEX)
               MOVE SPACES         TO M-BOOKKEY-CI
           END-IF.

           EJECT
       H100-VALIDATE-KEYS.

           MOVE 'H100' TO CA-PARAGRAPH-NBR.

           MOVE ZEROES TO W0001-COPY-CTR.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-LINE-LIMIT
                   IF  M-ACT-CI (W0001-X) > ' '
                       SET W0001-LINES-SELECTED  TO TRUE
                       MOVE W0001-X              TO WS-M-INDEX
                       ADD +1                    TO W0001-COPY-CTR
                   END-IF
           END-PERFORM.

           IF  W0001-LINES-SELECTED
               IF  W0001-COPY-CTR > +1
                   MOVE W9999-MSG-038  TO M-MSG-22I
                   MOVE -1             TO M-ACT-CL(1)
                   SET ERRORS          TO TRUE
               END-IF
           ELSE
               SET ERRORS              TO TRUE
               MOVE -1                 TO M-BOOKKEY-CL
               MOVE W9999-MSG-039      TO M-MSG-22I
           END-IF.

           IF  NO-ERRORS
               IF  M-BOOKKEY-CI = SPACES
                   MOVE W9999-MSG-051  TO M-MSG-22I
                   MOVE -1             TO M-BOOKKEY-CL
                   SET ERRORS          TO TRUE
               ELSE
                   PERFORM H110-VALIDATE-BOOK-ID-PREFIX
               END-IF
           END-IF.

           EJECT
       H110-VALIDATE-BOOK-ID-PREFIX.

           MOVE 'H110'      TO CA-PARAGRAPH-NBR.

           MOVE M-BOOKKEY-CI(1:2) TO W0001-BOOK-PREFIX.
           MOVE CA-OP-ID          TO A-UID-C     IN DCLT231SEC.

           EXEC SQL
                SELECT F_AFM_C
                  INTO :DCLT231SEC.F-AFM-C
                  FROM D231.T231SEC
                 WHERE A_UID_C       = :DCLT231SEC.A-UID-C
                   AND ((F_AFM_C       = :W0001-BOOK-PREFIX
                     AND DB_RECTYP_C   = 'B')
                    OR EXISTS
                       ( SELECT *
                           FROM D231.T231ACS B
                          WHERE B.A_UID_C    = :DCLT231SEC.A-UID-C
                            AND B.A_UIDTYP_C = 'C'))
           END-EXEC.

           SET MULTIPLE-ROWS TO TRUE.
           PERFORM Z900-DB2-CHECK.

           IF  DB2-NORMAL
           OR  DB2-MULTIPLE-ROWS
               SET W0001-LINES-SELECTED     TO TRUE
           ELSE
               MOVE W9999-MSG-027  TO M-MSG-22I
               MOVE -1             TO M-BOOKKEY-CL
               SET ERRORS          TO TRUE
           END-IF.

           EJECT
       H200-PROCESS-COPY-CURSOR.

           MOVE 'H200'      TO CA-PARAGRAPH-NBR.

           MOVE WS-M-F-BKID-C (WS-M-INDEX) TO F-BKID-C IN DCLT231BOOK.

           EXEC SQL
                OPEN CSR_7
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO
                      OR ERRORS
               EXEC SQL
                    FETCH CSR_7
                     INTO :DCLT231BOOK.F-BKID-C
                        , :DCLT231BOOK.F-RPTGRP-C
                        , :DCLT231BOOK.A-SEQ-N
                        , :DCLT231BOOK.DB-RECTYP-C
                        , :DCLT231BOOK.F-BKID-X
                        , :DCLT231BOOK.F-TBL-C
                        , :DCLT231BOOK.A-PGCNT-N
                        , :DCLT231BOOK.F-RPT01-C
                        , :DCLT231BOOK.F-RPT02-C
                        , :DCLT231BOOK.F-RPT03-C
                        , :DCLT231BOOK.F-RPT04-C
                        , :DCLT231BOOK.F-RPT05-C
                        , :DCLT231BOOK.F-RPT06-C
                        , :DCLT231BOOK.F-RPT07-C
                        , :DCLT231BOOK.F-RPT08-C
                        , :DCLT231BOOK.F-RPT09-C
                        , :DCLT231BOOK.F-RPT10-C
                        , :DCLT231BOOK.F-RPT11-C
                        , :DCLT231BOOK.F-RPT12-C
                        , :DCLT231BOOK.F-RPT13-C
                        , :DCLT231BOOK.F-RPT14-C
                        , :DCLT231BOOK.F-RPT15-C
                        , :DCLT231BOOK.F-RPT16-C
                        , :DCLT231BOOK.F-RPT17-C
                        , :DCLT231BOOK.F-RPT18-C
                        , :DCLT231BOOK.F-RPT19-C
                        , :DCLT231BOOK.F-RPT20-C
                        , :DCLT231BOOK.F-RPT21-C
                        , :DCLT231BOOK.F-RPT22-C
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   MOVE M-BOOKKEY-CI TO F-BKID-C IN DCLT231BOOK
                   SET DUP-KEY  TO TRUE
                   PERFORM H500-INSERT-T231BOOK
                   IF  DB2-NORMAL
                       CONTINUE
                   ELSE
                       SET ERRORS TO TRUE
                   END-IF
               END-IF
           END-PERFORM.

           EXEC SQL
               CLOSE CSR_7
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           EJECT
       H500-INSERT-T231BOOK.

           MOVE 'H500' TO CA-PARAGRAPH-NBR.

           EXEC SQL
             INSERT INTO D231.T231BOOK
                 ( F_BKID_C
                 , F_RPTGRP_C
                 , A_SEQ_N
                 , DB_RECTYP_C
                 , F_BKID_X
                 , F_TBL_C
                 , A_PGCNT_N
                 , F_RPT01_C
                 , F_RPT02_C
                 , F_RPT03_C
                 , F_RPT04_C
                 , F_RPT05_C
                 , F_RPT06_C
                 , F_RPT07_C
                 , F_RPT08_C
                 , F_RPT09_C
                 , F_RPT10_C
                 , F_RPT11_C
                 , F_RPT12_C
                 , F_RPT13_C
                 , F_RPT14_C
                 , F_RPT15_C
                 , F_RPT16_C
                 , F_RPT17_C
                 , F_RPT18_C
                 , F_RPT19_C
                 , F_RPT20_C
                 , F_RPT21_C
                 , F_RPT22_C
                 , DB_UPD_D
                 , DB_UPD_T )
             VALUES
                 ( :DCLT231BOOK.F-BKID-C
                 , :DCLT231BOOK.F-RPTGRP-C
                 , :DCLT231BOOK.A-SEQ-N
                 , :DCLT231BOOK.DB-RECTYP-C
                 , :DCLT231BOOK.F-BKID-X
                 , :DCLT231BOOK.F-TBL-C
                 , :DCLT231BOOK.A-PGCNT-N
                 , :DCLT231BOOK.F-RPT01-C
                 , :DCLT231BOOK.F-RPT02-C
                 , :DCLT231BOOK.F-RPT03-C
                 , :DCLT231BOOK.F-RPT04-C
                 , :DCLT231BOOK.F-RPT05-C
                 , :DCLT231BOOK.F-RPT06-C
                 , :DCLT231BOOK.F-RPT07-C
                 , :DCLT231BOOK.F-RPT08-C
                 , :DCLT231BOOK.F-RPT09-C
                 , :DCLT231BOOK.F-RPT10-C
                 , :DCLT231BOOK.F-RPT11-C
                 , :DCLT231BOOK.F-RPT12-C
                 , :DCLT231BOOK.F-RPT13-C
                 , :DCLT231BOOK.F-RPT14-C
                 , :DCLT231BOOK.F-RPT15-C
                 , :DCLT231BOOK.F-RPT16-C
                 , :DCLT231BOOK.F-RPT17-C
                 , :DCLT231BOOK.F-RPT18-C
                 , :DCLT231BOOK.F-RPT19-C
                 , :DCLT231BOOK.F-RPT20-C
                 , :DCLT231BOOK.F-RPT21-C
                 , :DCLT231BOOK.F-RPT22-C
                 , CURRENT DATE
                 , CURRENT TIME )
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           EJECT
       I000-DELETE-T231DSBK.

           MOVE 'I000'      TO CA-PARAGRAPH-NBR.

           IF  DELETE-REQUESTED
               CONTINUE
           ELSE
               MOVE -1              TO M-BOOKKEY-CL
               SET ERRORS           TO TRUE
               SET DELETE-REQUESTED TO TRUE
               MOVE W9999-MSG-024   TO M-MSG-22I
           END-IF.

           IF  NO-ERRORS
               PERFORM VARYING W0001-X FROM 1 BY 1
                 UNTIL W0001-X > W0001-SCREEN-LINE-LIMIT
                       IF  M-ACT-CI (W0001-X) > ' '
                           SET W0001-LINES-SELECTED  TO TRUE
                           PERFORM I100-DELETE-T231DSBK-ENTRY
                           MOVE SPACES  TO M-ACT-CI (W0001-X)
                           MOVE W0001-X TO W0001-IX
                           PERFORM C400-MOVE-BLANKS-TO-SCREEN
                       END-IF
               END-PERFORM

               IF  W0001-LINES-SELECTED
                   MOVE -1                  TO M-BOOKKEY-CL
                   MOVE W9999-MSG-014       TO M-MSG-22I
                   SET DELETE-NOT-REQUESTED TO TRUE
               ELSE
                   MOVE -1                  TO M-BOOKKEY-CL
                   SET ERRORS               TO TRUE
                   MOVE W9999-MSG-025       TO M-MSG-22I
               END-IF
           END-IF.

           EJECT
       I100-DELETE-T231DSBK-ENTRY.

           MOVE 'I100'      TO CA-PARAGRAPH-NBR.

           MOVE CA-CURR-F-DSID-C     TO F-DSID-C    IN DCLT231DSBK.
           MOVE CA-CURR-F-DSID-N     TO F-DSLN-N    IN DCLT231DSBK.
           MOVE M-BKID-CI (W0001-X)  TO F-BKID-C    IN DCLT231DSBK.

           EXEC SQL
                DELETE FROM D231.T231DSBK
                 WHERE F_DSID_C        = :DCLT231DSBK.F-DSID-C
                   AND F_DSLN_N        = :DCLT231DSBK.F-DSLN-N
                   AND F_BKID_C        = :DCLT231DSBK.F-BKID-C
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           EJECT
       J000-ADD-BOOK-TO-DIST.

           MOVE 'J000'      TO CA-PARAGRAPH-NBR.


           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-A-LN-LIMIT
                OR ERRORS
                   IF  M-ACT-CAI (W0001-X) > ' '
                       SET W0001-LINES-SELECTED TO TRUE
                       MOVE M-BKID-CAI (W0001-X)
                         TO M-BOOKKEY-CI

                       PERFORM G200-INSERT-T231DSBK-LINE

                       MOVE SPACES TO M-ACT-CAI (W0001-X)
                   END-IF
           END-PERFORM.

           IF  W0001-LINES-SELECTED
               CONTINUE
           ELSE
               MOVE W9999-MSG-055    TO M-MSG-22AI
               MOVE -1               TO M-BOOKKEY-CAL
               SET ERRORS            TO TRUE
           END-IF.

           IF  NO-ERRORS
               MOVE W9999-MSG-012    TO M-MSG-22AI
               MOVE -1               TO M-BOOKKEY-CAL
               MOVE SPACES           TO M-BOOKKEY-CAI
               SET INSERT-SUCCESSFUL TO TRUE
           END-IF.

           EJECT
       K000-DELETE-T231BOOK.

           MOVE 'K000'      TO CA-PARAGRAPH-NBR.

           IF  DELETE-REQUESTED
               CONTINUE
           ELSE
               MOVE -1              TO M-BOOKKEY-CAL
               SET ERRORS           TO TRUE
               SET DELETE-REQUESTED TO TRUE
               MOVE W9999-MSG-024   TO M-MSG-22AI
           END-IF.

           IF  NO-ERRORS
               PERFORM VARYING W0001-X FROM 1 BY 1
                 UNTIL W0001-X > W0001-SCREEN-A-LN-LIMIT
                       IF  M-ACT-CAI (W0001-X) > ' '
                           SET W0001-LINES-SELECTED  TO TRUE
                           PERFORM K100-DELETE-T231BOOK-GROUP
                           MOVE SPACES TO M-ACT-CAI (W0001-X)
                       END-IF
               END-PERFORM

               IF  W0001-LINES-SELECTED
                   MOVE -1                  TO M-BOOKKEY-CAL
                   MOVE W9999-MSG-014       TO M-MSG-22AI
                   SET DELETE-NOT-REQUESTED TO TRUE
               ELSE
                   MOVE -1                  TO M-BOOKKEY-CAL
                   SET ERRORS               TO TRUE
                   MOVE W9999-MSG-025       TO M-MSG-22AI
               END-IF
           END-IF.

           EJECT
       K100-DELETE-T231BOOK-GROUP.

           MOVE 'K100'      TO CA-PARAGRAPH-NBR.

           MOVE WS-M-A-F-BKID-C    (W0001-X)
             TO F-BKID-C           IN DCLT231BOOK.

           EXEC SQL
                DELETE FROM D231.T231BOOK
                 WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           EJECT
       L100-PROCESS-ENTER-KEY.

           MOVE 'L100'      TO CA-PARAGRAPH-NBR.

           IF  NO-ERRORS
               MOVE W9999-MSG-019  TO M-MSG-22BI
               MOVE -1             TO M-BKID-XBL
           END-IF.

           EJECT
       L200-UPDATE-T231BOOK.

           MOVE 'L200'      TO CA-PARAGRAPH-NBR.

           MOVE WS-M-F-BKID-C      (WS-M-INDEX)
             TO F-BKID-C           IN DCLT231BOOK.

           PERFORM L210-DELETE-MEMO-PAGE

           IF  NO-ERRORS
               MOVE WS-M-F-BKID-C      (WS-M-INDEX)
                 TO F-BKID-C           IN DCLT231BOOK
               MOVE SPACES
                 TO F-RPTGRP-C         IN DCLT231BOOK
               MOVE '/'
                 TO DB-RECTYP-C        IN DCLT231BOOK
      *BWM*    MOVE WS-M-A-SEQ-N       (WS-M-INDEX)
               MOVE +1
                 TO A-SEQ-N            IN DCLT231BOOK

               MOVE M-BKID-XBI
                 TO F-BKID-X           IN DCLT231BOOK
                    WS-M-F-BKID-X      (WS-M-INDEX)

               PERFORM H500-INSERT-T231BOOK

               IF  DB2-NORMAL
                   CONTINUE
               ELSE
                   SET ERRORS          TO TRUE
                   MOVE W9999-MSG-023  TO M-MSG-22BI
                   MOVE -1             TO M-BKID-XBL
               END-IF
           END-IF.

           IF  NO-ERRORS
               PERFORM L400-CREATE-MEMO-PAGE
           END-IF.

           IF  NO-ERRORS
               SET INSERT-SUCCESSFUL TO TRUE
               MOVE W9999-MSG-013  TO M-MSG-22BI
               MOVE -1             TO M-BKID-XBL
           ELSE
               PERFORM Y600-ROLLBACK
           END-IF.

           EJECT
       L210-DELETE-MEMO-PAGE.

           MOVE 'L210'      TO CA-PARAGRAPH-NBR.

           EXEC SQL
                DELETE FROM D231.T231BOOK
                 WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
                   AND F_RPTGRP_C    = '   '
                   AND DB_RECTYP_C  IN ('1','/')
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           EJECT
       L400-CREATE-MEMO-PAGE.

           MOVE 'L400'      TO CA-PARAGRAPH-NBR.

           INITIALIZE DCLT231BOOK.
           MOVE +1 TO A-SEQ-N IN DCLT231BOOK.

           IF  NO-ERRORS
               PERFORM VARYING W0001-IX FROM 1 BY 1
                 UNTIL W0001-IX > W0001-SCREEN-B-LN-LIMIT
                   IF  M-MEMO-CBI (W0001-IX) > SPACES
                       PERFORM L420-BUILD-MEMO-PAGE
                       PERFORM H500-INSERT-T231BOOK
                   END-IF
               END-PERFORM
           END-IF.

           EJECT
       L420-BUILD-MEMO-PAGE.

           MOVE 'L420'      TO CA-PARAGRAPH-NBR.

           MOVE WS-M-F-BKID-C      (WS-M-INDEX)
             TO F-BKID-C           IN DCLT231BOOK.
           MOVE SPACES
             TO F-RPTGRP-C         IN DCLT231BOOK.
           MOVE '1'
             TO DB-RECTYP-C        IN DCLT231BOOK.
           ADD +1
             TO A-SEQ-N            IN DCLT231BOOK.

           MOVE M-MEMO-CBI         (W0001-IX)
             TO F-BKID-X           IN DCLT231BOOK.

           EJECT
       M000-PROCESS-MEMO-PAGE.

           MOVE 'M000'      TO CA-PARAGRAPH-NBR.

           IF  NO-ERRORS
               PERFORM M200-GET-T231BOOK-LINES

               IF  W0001-IX > 1 AND <= W0001-SCREEN-B-LN-LIMIT
                   PERFORM UNTIL W0001-IX > W0001-SCREEN-B-LN-LIMIT
                       MOVE SPACES TO M-MEMO-CBI (W0001-IX)
                       ADD +1 TO W0001-IX
                   END-PERFORM
               ELSE
                   IF  W0001-IX = 1 AND EIBAID = DFHENTER
                       PERFORM VARYING W0001-IX FROM 1  Y 1
                         UNTIL W0001-IX > W0001-SCREEN-B-LN-LIMIT
                           MOVE SPACES TO M-MEMO-CBI (W0001-IX)
                       END-PERFORM
                   END-IF
               END-IF
           ELSE
               PERFORM VARYING W0001-IX FROM 1 BY 1
                 UNTIL W0001-IX > W0001-SCREEN-B-LN-LIMIT
                   MOVE SPACES TO M-MEMO-CBI (W0001-IX)
               END-PERFORM
           END-IF.

           EJECT
       M200-GET-T231BOOK-LINES.

           MOVE 'M200'      TO CA-PARAGRAPH-NBR.

           MOVE M-BKID-CBI          TO F-BKID-C     IN DCLT231BOOK.

           EXEC SQL
                OPEN CSR_8
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           MOVE +1 TO W0001-IX.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO
                      OR W0001-IX > W0001-SCREEN-B-LN-LIMIT
               EXEC SQL
                    FETCH CSR_8
                     INTO :DCLT231BOOK.F-BKID-C
                        , :DCLT231BOOK.F-RPTGRP-C
                        , :DCLT231BOOK.A-SEQ-N
                        , :DCLT231BOOK.DB-RECTYP-C
                        , :DCLT231BOOK.F-BKID-X
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   MOVE F-BKID-X          IN DCLT231BOOK
                     TO M-MEMO-CBI        (W0001-IX)

                   ADD +1 TO W0001-IX
               END-IF
           END-PERFORM.

           EXEC SQL
               CLOSE CSR_8
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           IF  NO-ERRORS
               MOVE W9999-MSG-001  TO M-MSG-22AI
               MOVE -1             TO M-BOOKKEY-CAL
           END-IF.

           EJECT
       N000-COPY-TO-NEW-BOOK.

           MOVE 'N000'      TO CA-PARAGRAPH-NBR.

           PERFORM N100-VALIDATE-KEYS.

           IF  NO-ERRORS
               PERFORM N200-PROCESS-COPY-CURSOR
               IF  NO-ERRORS
                   CONTINUE
               ELSE
                   PERFORM Y600-ROLLBACK
                   SET ERRORS          TO TRUE
                   MOVE -1             TO M-BOOKKEY-CAL
                   MOVE W9999-MSG-050  TO M-MSG-22AI
               END-IF
           END-IF.

           IF  NO-ERRORS
               MOVE -1             TO M-BOOKKEY-CAL
               MOVE W9999-MSG-020  TO M-MSG-22AI
               INITIALIZE             WS-M-A-MIN-VALUES
               MOVE M-BOOKKEY-CAI  TO WS-M-A-MIN-BKID-C
               MOVE SPACES         TO M-ACT-CAI (WS-M-INDEX)
               MOVE SPACES         TO M-BOOKKEY-CAI
           END-IF.

           EJECT
       N100-VALIDATE-KEYS.

           MOVE 'N100' TO CA-PARAGRAPH-NBR.

           MOVE ZEROES TO W0001-COPY-CTR.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-A-LN-LIMIT
                   IF  M-ACT-CAI (W0001-X) > ' '
                       SET W0001-LINES-SELECTED  TO TRUE
                       MOVE W0001-X              TO WS-M-INDEX
                       ADD +1                    TO W0001-COPY-CTR
                   END-IF
           END-PERFORM.

           IF  W0001-LINES-SELECTED
               IF  W0001-COPY-CTR > +1
                   MOVE W9999-MSG-038  TO M-MSG-22AI
                   MOVE -1             TO M-ACT-CL(1)
                   SET ERRORS          TO TRUE
               END-IF
           ELSE
               SET ERRORS              TO TRUE
               MOVE -1                 TO M-BOOKKEY-CAL
               MOVE W9999-MSG-039      TO M-MSG-22AI
           END-IF.

           IF  NO-ERRORS
               IF  M-BOOKKEY-CAI = SPACES
                   MOVE W9999-MSG-051  TO M-MSG-22AI
                   MOVE -1             TO M-BOOKKEY-CAL
                   SET ERRORS          TO TRUE
               ELSE
                   PERFORM N110-VALIDATE-BOOK-ID-PREFIX
               END-IF
           END-IF.

           EJECT
       N110-VALIDATE-BOOK-ID-PREFIX.

           MOVE 'N110'      TO CA-PARAGRAPH-NBR.

           MOVE M-BOOKKEY-CAI(1:2) TO W0001-BOOK-PREFIX.
           MOVE CA-OP-ID          TO A-UID-C     IN DCLT231SEC.

           EXEC SQL
                SELECT F_AFM_C
                  INTO :DCLT231SEC.F-AFM-C
                  FROM D231.T231SEC A
                 WHERE A_UID_C       = :DCLT231SEC.A-UID-C
                   AND ((F_AFM_C       = :W0001-BOOK-PREFIX
                     AND DB_RECTYP_C   = 'B')
                    OR EXISTS
                       ( SELECT *
                           FROM D231.T231ACS B
                          WHERE B.A_UID_C    = :DCLT231SEC.A-UID-C
                            AND B.A_UIDTYP_C = 'C'))
           END-EXEC.

           SET MULTIPLE-ROWS TO TRUE.
           PERFORM Z900-DB2-CHECK.

           IF  DB2-NORMAL
           OR  DB2-MULTIPLE-ROWS
               SET W0001-LINES-SELECTED     TO TRUE
           ELSE
               MOVE W9999-MSG-027  TO M-MSG-22AI
               MOVE -1             TO M-BOOKKEY-CAL
               SET ERRORS          TO TRUE
           END-IF.

           EJECT
       N200-PROCESS-COPY-CURSOR.

           MOVE 'N200'      TO CA-PARAGRAPH-NBR.

           MOVE WS-M-A-F-BKID-C (WS-M-INDEX)
             TO F-BKID-C IN DCLT231BOOK.

           EXEC SQL
                OPEN CSR_7
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO
                      OR ERRORS
               EXEC SQL
                    FETCH CSR_7
                     INTO :DCLT231BOOK.F-BKID-C
                        , :DCLT231BOOK.F-RPTGRP-C
                        , :DCLT231BOOK.A-SEQ-N
                        , :DCLT231BOOK.DB-RECTYP-C
                        , :DCLT231BOOK.F-BKID-X
                        , :DCLT231BOOK.F-TBL-C
                        , :DCLT231BOOK.A-PGCNT-N
                        , :DCLT231BOOK.F-RPT01-C
                        , :DCLT231BOOK.F-RPT02-C
                        , :DCLT231BOOK.F-RPT03-C
                        , :DCLT231BOOK.F-RPT04-C
                        , :DCLT231BOOK.F-RPT05-C
                        , :DCLT231BOOK.F-RPT06-C
                        , :DCLT231BOOK.F-RPT07-C
                        , :DCLT231BOOK.F-RPT08-C
                        , :DCLT231BOOK.F-RPT09-C
                        , :DCLT231BOOK.F-RPT10-C
                        , :DCLT231BOOK.F-RPT11-C
                        , :DCLT231BOOK.F-RPT12-C
                        , :DCLT231BOOK.F-RPT13-C
                        , :DCLT231BOOK.F-RPT14-C
                        , :DCLT231BOOK.F-RPT15-C
                        , :DCLT231BOOK.F-RPT16-C
                        , :DCLT231BOOK.F-RPT17-C
                        , :DCLT231BOOK.F-RPT18-C
                        , :DCLT231BOOK.F-RPT19-C
                        , :DCLT231BOOK.F-RPT20-C
                        , :DCLT231BOOK.F-RPT21-C
                        , :DCLT231BOOK.F-RPT22-C
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   MOVE M-BOOKKEY-CAI TO F-BKID-C IN DCLT231BOOK
                   SET DUP-KEY  TO TRUE
                   PERFORM H500-INSERT-T231BOOK
                   IF  DB2-NORMAL
                       CONTINUE
                   ELSE
                       SET ERRORS TO TRUE
                   END-IF
               END-IF
           END-PERFORM.

           EXEC SQL
               CLOSE CSR_7
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           EJECT
      **===========================================================**
      **   COPYBOOK AREA FOR CICS CONTROL AND SUB-MODULES          **
      **===========================================================**
           EXEC SQL
              INCLUDE C108Z000
           END-EXEC.

           EJECT
           COPY C108Z900.

           EJECT
           COPY C108Z998.

